1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426 | ------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . B B . B O A R D _ S U P P O R T --
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2002 Universidad Politecnica de Madrid --
-- Copyright (C) 2003-2006 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/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
-- The port of GNARL to bare board targets was initially developed by the --
-- Real-Time Systems Group at the Technical University of Madrid. --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
with System.Machine_Code;
with System.BB.CPU_Primitives.Multiprocessors;
with Interfaces; use Interfaces;
with Interfaces.Raspberry_Pi;
package body System.BB.Board_Support is
use BB.Interrupts;
use System.Machine_Code;
use System.Multiprocessors;
use Interfaces.Raspberry_Pi;
procedure IRQ_Handler;
pragma Export (Ada, IRQ_Handler, "__gnat_irq_handler");
procedure FIQ_Handler;
pragma Export (Ada, FIQ_Handler, "__gnat_fiq_handler");
-- Low-level interrupt handler
procedure Initialize_CPU_Devices;
pragma Export (C, Initialize_CPU_Devices, "__gnat_initialize_cpu_devices");
-- Per CPU device initialization
procedure Set_CNTP_CTL (Val : Unsigned_32);
procedure Set_CNTV_CTL (Val : Unsigned_32);
-- Set the CNTP_CTL and CNTV_CTL register
------------------
-- Set_CNTP_CTL --
------------------
procedure Set_CNTP_CTL (Val : Unsigned_32) is
begin
Asm ("mcr p15, #0, %0, c14, c2, #1",
Inputs => Unsigned_32'Asm_Input ("r", Val),
Volatile => True);
end Set_CNTP_CTL;
procedure Set_CNTV_CTL (Val : Unsigned_32) is
begin
Asm ("mcr p15, #0, %0, c14, c3, #1",
Inputs => Unsigned_32'Asm_Input ("r", Val),
Volatile => True);
end Set_CNTV_CTL;
----------------------------
-- Initialize_CPU_Devices --
----------------------------
procedure Initialize_CPU_Devices is
begin
-- Disable CNTP and mask.
Set_CNTP_CTL (2);
-- Disable CNTV and mask.
Set_CNTV_CTL (2);
end Initialize_CPU_Devices;
----------------------
-- Initialize_Board --
----------------------
procedure Initialize_Board is
Discard : Unsigned_32;
begin
-- Timer: set prescalar to 1, using crystal (19.2 Mhz)
Local_Registers.Core_Timer_Prescaler := 16#8000_0000#;
Local_Registers.Control := 0;
-- Read MS to unlock the LS.
Discard := Local_Registers.Core_Timer_MS;
-- Initialize (LS then MS)
Local_Registers.Core_Timer_LS := 0;
Local_Registers.Core_Timer_MS := 0;
-- GPU interrupt routing to core 1
Local_Registers.GPU_Int_Routing := 2#00_00#;
-- Disable PMU ints
Local_Registers.PMU_Int_Routing_Clr := 2#1111_1111#;
-- Core timer PS to IRQ
for I in Core_Unsigned_32'Range loop
Local_Registers.Cores_Timer_Int_Ctr (I) := 2#0000_1111#;
end loop;
-- Mailbox to IRQ
for I in Core_Unsigned_32'Range loop
Local_Registers.Cores_Mailboxes_Int_Ctr (I) := 2#0000_1111#;
end loop;
Initialize_CPU_Devices;
end Initialize_Board;
package body Time is
Alarm_Interrupt_ID : constant BB.Interrupts.Interrupt_ID := 1;
-- Non-secure counter (CNTPNSIRQ)
---------------
-- Set_Alarm --
---------------
procedure Set_Alarm (Ticks : BB.Time.Time)
is
use type BB.Time.Time;
Lo : constant Unsigned_32 := Unsigned_32 (Ticks and 16#FFFF_FFFF#);
Hi : constant Unsigned_32 :=
Unsigned_32 (Shift_Right (Unsigned_64 (Ticks), 32));
begin
-- Set CNTP_CVAL
Asm ("mcrr p15,#2,%0,%1,c14",
Inputs => (Unsigned_32'Asm_Input ("r", Lo),
Unsigned_32'Asm_Input ("r", Hi)),
Volatile => True);
-- Set CNTP_CTL (enable and unmask)
Set_CNTP_CTL (1);
end Set_Alarm;
----------------
-- Read_Clock --
----------------
function Read_Clock return BB.Time.Time is
use BB.Time;
Lo : Unsigned_32;
Hi : Unsigned_32;
begin
-- Read CNTPCT
Asm ("mrrc p15,#0,%0,%1,c14",
Outputs => (Unsigned_32'Asm_Output ("=r", Lo),
Unsigned_32'Asm_Output ("=r", Hi)),
Volatile => True);
return (BB.Time.Time (Hi) * 2 ** 32) + BB.Time.Time (Lo);
end Read_Clock;
---------------------------
-- Install_Alarm_Handler --
---------------------------
procedure Install_Alarm_Handler (Handler : Interrupt_Handler) is
begin
-- Attach interrupt handler
BB.Interrupts.Attach_Handler
(Handler,
Alarm_Interrupt_ID,
Interrupts.Priority_Of_Interrupt (Alarm_Interrupt_ID));
end Install_Alarm_Handler;
---------------------------
-- Clear_Alarm_Interrupt --
---------------------------
procedure Clear_Alarm_Interrupt is
begin
-- Disable and mask
Set_CNTP_CTL (2);
end Clear_Alarm_Interrupt;
end Time;
-----------------
-- IRQ_Handler --
-----------------
procedure IRQ_Handler
is
This_CPU : constant CPU := Multiprocessors.Current_CPU;
Src : constant Unsigned_32 :=
Local_Registers.Cores_IRQ_Source (Natural (This_CPU));
Pending : Unsigned_32;
IRQ : Interrupt_ID;
Base : Integer_32;
subtype Basic_IRQ is Interrupt_ID range 0 .. 11;
function CTZ (X : Unsigned_32) return Integer_32
with Import, Convention => Intrinsic, External_Name => "__builtin_ctz";
-- Returns the number of leading zeros in X, starting at the least
-- significant position. X must not be zero.
begin
if Src = 0 then
return;
end if;
-- Retrieve the IRQ number
Base := CTZ (Src);
if Base = 8 then
-- GPU interrupt: retrieve the source IRQ
IRQ := Basic_IRQ'Last + 1;
Pending := Arm_Interrupts.Irq_Pending_1;
if Pending = 0 then
Pending := Arm_Interrupts.Irq_Pending_2;
IRQ := IRQ + 32;
end if;
if Pending = 0 then
return;
end if;
IRQ := IRQ + Interrupt_ID (CTZ (Pending));
Interrupt_Wrapper (IRQ);
else
Interrupt_Wrapper (Interrupt_ID (Base));
end if;
end IRQ_Handler;
-----------------
-- FIQ_Handler --
-----------------
procedure FIQ_Handler is
begin
-- Not supported
raise Program_Error;
end FIQ_Handler;
package body Interrupts is
-------------------------------
-- Install_Interrupt_Handler --
-------------------------------
procedure Install_Interrupt_Handler
(Interrupt : BB.Interrupts.Interrupt_ID;
Prio : Interrupt_Priority)
is
pragma Unreferenced (Prio);
Int_Num : Natural;
Reg_Value : Unsigned_32;
GPU_Int_Base_1 : constant := 12;
GPU_Int_Base_2 : constant := 44;
begin
if Interrupt < 12 then
return;
elsif Interrupt < GPU_Int_Base_2 then
Int_Num := Natural (Interrupt) - GPU_Int_Base_1;
Reg_Value := 2 ** Int_Num;
Arm_Interrupts.Enable_Irq_1 := Reg_Value;
else
Int_Num := Natural (Interrupt) - GPU_Int_Base_2;
Reg_Value := 2 ** Int_Num;
Arm_Interrupts.Enable_Irq_2 := Reg_Value;
end if;
end Install_Interrupt_Handler;
---------------------------
-- Priority_Of_Interrupt --
---------------------------
function Priority_Of_Interrupt
(Interrupt : System.BB.Interrupts.Interrupt_ID)
return System.Any_Priority
is
pragma Unreferenced (Interrupt);
begin
return Interrupt_Priority'First; -- IRQ
end Priority_Of_Interrupt;
--------------------------
-- Set_Current_Priority --
--------------------------
procedure Set_Current_Priority (Priority : Integer) is
begin
null;
end Set_Current_Priority;
----------------
-- Power_Down --
----------------
procedure Power_Down is
begin
Asm ("wfi", Volatile => True);
end Power_Down;
end Interrupts;
package body Multiprocessors is
Poke_Interrupt : constant Interrupt_ID := 7;
-- Use mailbox 3
procedure Start_Slave_Cpu
with Import, External_Name => "__start_slave_cpu";
-- Entry point (in crt0) for a slave cpu
procedure Poke_Handler (Interrupt : BB.Interrupts.Interrupt_ID);
-- Handler for the Poke interrupt
function MPIDR return Unsigned_32 with Inline_Always;
-- Return current value of the MPIDR register
--------------------
-- Number_Of_CPUs --
--------------------
function Number_Of_CPUs return CPU is
begin
return CPU'Last;
end Number_Of_CPUs;
-----------
-- MPIDR --
-----------
function MPIDR return Unsigned_32 is
R : Unsigned_32;
begin
Asm ("mrc p15,0,%0,c0,c0,5",
Outputs => Unsigned_32'Asm_Output ("=r", R),
Volatile => True);
return R;
end MPIDR;
-----------------
-- Current_CPU --
-----------------
function Current_CPU return CPU is
-- Get CPU Id from bits 1:0 from the MPIDR register
(if CPU'Last = 1 then 1 else CPU ((MPIDR and 3) + 1));
--------------
-- Poke_CPU --
--------------
procedure Poke_CPU (CPU_Id : CPU) is
begin
Local_Registers.Cores_Mailboxes_Write_Set (Natural (CPU_Id), 3) := 1;
end Poke_CPU;
--------------------
-- Start_All_CPUs --
--------------------
procedure Start_All_CPUs is
function To_Unsigned_32 is new Ada.Unchecked_Conversion
(Address, Unsigned_32);
begin
BB.Interrupts.Attach_Handler
(Poke_Handler'Access, Poke_Interrupt, Interrupt_Priority'Last);
-- Disable warnings for non-SMP case
pragma Warnings (Off, "loop range is null*");
for CPU_Id in CPU'First + 1 .. CPU'Last loop
-- Set entry point address for the slave
Local_Registers.Cores_Mailboxes_Write_Set (Natural (CPU_Id), 3) :=
To_Unsigned_32 (Start_Slave_Cpu'Address);
-- Wait until the slave starts
while Local_Registers.Cores_Mailboxes_Read_Clr
(Natural (CPU_Id), 3) /= 0
loop
null;
end loop;
end loop;
pragma Warnings (On, "loop range is null*");
end Start_All_CPUs;
------------------
-- Poke_Handler --
------------------
procedure Poke_Handler (Interrupt : BB.Interrupts.Interrupt_ID) is
This_CPU : constant CPU := Multiprocessors.Current_CPU;
begin
-- Make sure we are handling the right interrupt
pragma Assert (Interrupt = Poke_Interrupt);
-- Clear bit in mailbox
Local_Registers.Cores_Mailboxes_Read_Clr (Natural (This_CPU), 3) := 1;
System.BB.CPU_Primitives.Multiprocessors.Poke_Handler;
end Poke_Handler;
end Multiprocessors;
end System.BB.Board_Support;
|