File : s-bbbosu-xtratum-arm.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . B B . B O A R D _ S U P P O R T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1999-2002 Universidad Politecnica de Madrid --
10 -- Copyright (C) 2003-2006 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 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
31 -- --
32 -- The port of GNARL to bare board targets was initially developed by the --
33 -- Real-Time Systems Group at the Technical University of Madrid. --
34 -- --
35 ------------------------------------------------------------------------------
36
37 -- This is the XtratuM version of this package
38
39 pragma Restrictions (No_Elaboration_Code);
40
41 with Interfaces.C;
42
43 with System.BB.Parameters;
44 with System.Machine_Code;
45
46 package body System.BB.Board_Support is
47
48 use CPU_Primitives;
49 use Interfaces.C;
50
51 -----------------------
52 -- Local Definitions --
53 -----------------------
54
55 XM_HW_CLOCK : constant := 0;
56 -- Real-time clock
57
58 type XM_Time_T is range -2 ** 63 .. 2 ** 63 - 1;
59 for XM_Time_T'Size use 64;
60 -- Time in XtratuM
61
62 XM_VT_EXT_FIRST : constant := 32;
63 -- First XtratuM extended interrupt
64
65 XM_VT_EXT_HW_TIMER : constant := 0;
66 -- Real-time timer interrupt (extended interrupt)
67
68 HW_Timer_Unmasked : Boolean := False;
69 -- Flag to know whether the timer IRQ has already been unmasked
70
71 ----------------------
72 -- Local Procedures --
73 ----------------------
74
75 procedure Get_Time (Clock_Id : unsigned; Time : access XM_Time_T);
76 pragma Import (C, Get_Time, "XM_get_time");
77 -- Read clock
78
79 procedure Set_Timer
80 (Clock_Id : unsigned; AbsTime : XM_Time_T; Interval : XM_Time_T);
81 pragma Import (C, Set_Timer, "XM_set_timer");
82 -- Set hardware timer
83
84 procedure Clear_IRQ_Mask (HwIrqsMask : Address; ExtIrqsMask : unsigned);
85 pragma Import (C, Clear_IRQ_Mask, "XM_clear_irqmask");
86 -- Unmask IRQs
87
88 ------------------------
89 -- Alarm_Interrupt_ID --
90 ------------------------
91
92 function Alarm_Interrupt_ID return Interrupts.Interrupt_ID is
93 begin
94 -- This is an extended interrupt, identified by offset XM_VT_EXT_FIRST
95
96 return XM_VT_EXT_FIRST + XM_VT_EXT_HW_TIMER;
97 end Alarm_Interrupt_ID;
98
99 ---------------------------
100 -- Clear_Alarm_Interrupt --
101 ---------------------------
102
103 procedure Clear_Alarm_Interrupt is
104 begin
105 -- Interrupts are cleared automatically when they are acknowledged
106
107 null;
108 end Clear_Alarm_Interrupt;
109
110 -----------------------------
111 -- Clear_Interrupt_Request --
112 -----------------------------
113
114 procedure Clear_Interrupt_Request
115 (Interrupt : System.BB.Interrupts.Interrupt_ID)
116 is
117 begin
118
119 -- Nothing to do for the IPIC
120
121 null;
122 end Clear_Interrupt_Request;
123
124 --------------------------
125 -- Clear_Poke_Interrupt --
126 --------------------------
127
128 procedure Clear_Poke_Interrupt is
129 begin
130 -- Interrupts are cleared automatically when they are acknowledged
131
132 null;
133 end Clear_Poke_Interrupt;
134
135 ----------------------
136 -- Initialize_Board --
137 ----------------------
138
139 procedure Initialize_Board is
140 begin
141 null;
142 end Initialize_Board;
143
144 ------------------------
145 -- Max_Timer_Interval --
146 ------------------------
147
148 function Max_Timer_Interval return Timer_Interval is
149 begin
150 return Timer_Interval'Last;
151 end Max_Timer_Interval;
152
153 -----------------------
154 -- Poke_Interrupt_ID --
155 -----------------------
156
157 function Poke_Interrupt_ID return Interrupts.Interrupt_ID is
158 begin
159 return 0;
160 end Poke_Interrupt_ID;
161
162 ---------------------------
163 -- Priority_Of_Interrupt --
164 ---------------------------
165
166 function Priority_Of_Interrupt
167 (Interrupt : System.BB.Interrupts.Interrupt_ID) return System.Any_Priority
168 is
169 begin
170 -- Assert that it is a real interrupt
171
172 pragma Assert (Interrupt /= System.BB.Interrupts.No_Interrupt);
173
174 return Interrupt_Priority'First;
175 end Priority_Of_Interrupt;
176
177 ----------------
178 -- Read_Clock --
179 ----------------
180
181 function Read_Clock return Timer_Interval is
182 XtratuM_Time : aliased XM_Time_T;
183
184 pragma Suppress (Range_Check);
185 -- Suppress this check so we can use a fast implementation for taking
186 -- the lower part of the time (the 32 least significant bits) by simply
187 -- ignoring the most significant part.
188
189 begin
190 Get_Time (XM_HW_CLOCK, XtratuM_Time'Access);
191
192 -- Take the lower 32-bit
193
194 return Timer_Interval (XtratuM_Time);
195 end Read_Clock;
196
197 ---------------
198 -- Set_Alarm --
199 ---------------
200
201 procedure Set_Alarm (Ticks : Timer_Interval) is
202 XtratuM_Time : aliased XM_Time_T;
203
204 begin
205 -- Transform into absolute time
206
207 Get_Time (XM_HW_CLOCK, XtratuM_Time'Access);
208 Set_Timer (XM_HW_CLOCK, XtratuM_Time + XM_Time_T (Ticks), 0);
209
210 if not HW_Timer_Unmasked then
211 Clear_IRQ_Mask (Null_Address, 2 ** XM_VT_EXT_HW_TIMER);
212 HW_Timer_Unmasked := True;
213 end if;
214 end Set_Alarm;
215
216 --------------------------
217 -- Set_Current_Priority --
218 --------------------------
219
220 procedure Set_Current_Priority (Priority : Integer) is
221 begin
222 null; -- No board-specific actions necessary
223 end Set_Current_Priority;
224
225 ----------------------
226 -- Ticks_Per_Second --
227 ----------------------
228
229 function Ticks_Per_Second return Natural is
230 begin
231 return Parameters.Clock_Frequency;
232 end Ticks_Per_Second;
233
234 ---------------------------
235 -- Get_Interrupt_Request --
236 ---------------------------
237
238 function Get_Interrupt_Request
239 (Vector : CPU_Primitives.Vector_Id)
240 return System.BB.Interrupts.Interrupt_ID
241 is
242 pragma Unreferenced (Vector);
243
244 function Get_Irq_Nr return System.BB.Interrupts.Interrupt_ID;
245 pragma Import (Ada, Get_Irq_Nr, "__gnat_get_irq_nr");
246
247 begin
248 return Get_Irq_Nr;
249 end Get_Interrupt_Request;
250
251 -------------------------------
252 -- Install_Interrupt_Handler --
253 -------------------------------
254
255 procedure Install_Interrupt_Handler
256 (Handler : Address;
257 Interrupt : Interrupts.Interrupt_ID;
258 Prio : Interrupt_Priority)
259 is
260 pragma Unreferenced (Interrupt, Prio);
261
262 begin
263 -- Install Handler as the IRQ handler. Hopefully, it is always
264 -- BB.Interrupts.Interrupt_Wrapper.
265
266 CPU_Primitives.Install_Trap_Handler
267 (Handler, CPU_Primitives.Vector_Id (5));
268 end Install_Interrupt_Handler;
269
270 end System.BB.Board_Support;