File : s-bbbosu-xtratum.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 use CPU_Primitives;
48 use Interfaces.C;
49
50 -----------------------
51 -- Local Definitions --
52 -----------------------
53
54 XM_HW_CLOCK : constant := 0;
55 -- Real-time clock
56
57 type XM_Time_T is range -2 ** 63 .. 2 ** 63 - 1;
58 for XM_Time_T'Size use 64;
59 -- Time in XtratuM
60
61 XM_VT_EXT_FIRST : constant := 16;
62 -- First XtratuM extended interrupt
63
64 XM_VT_EXT_HW_TIMER : constant := 0;
65 -- Real-time timer interrupt (extended interrupt)
66
67 HW_Timer_Unmasked : Boolean := False;
68 -- Flag to know whether the timer IRQ has already been unmasked
69
70 Flush_Register_Windows : constant Vector_Id := 16#83#;
71 -- The trap number associated to the flush register windows (ta 3)
72
73 ----------------------
74 -- Local Procedures --
75 ----------------------
76
77 procedure Get_Time (Clock_Id : unsigned; Time : access XM_Time_T);
78 pragma Import (C, Get_Time, "XM_get_time");
79 -- Read clock
80
81 procedure Set_Timer
82 (Clock_Id : unsigned; AbsTime : XM_Time_T; Interval : XM_Time_T);
83 pragma Import (C, Set_Timer, "XM_set_timer");
84 -- Set hardware timer
85
86 procedure Clear_IRQ_Mask (HwIrqsMask : unsigned; ExtIrqsMask : unsigned);
87 pragma Import (C, Clear_IRQ_Mask, "XM_clear_irqmask");
88 -- Unmask IRQs
89
90 procedure Flush_Windows_Handler;
91 -- Handler to install for the flush register windows trap (ta 3)
92
93 ------------------------
94 -- Alarm_Interrupt_ID --
95 ------------------------
96
97 function Alarm_Interrupt_ID return Interrupts.Interrupt_ID is
98 begin
99 -- This is an extended interrupt, identified by offset XM_VT_EXT_FIRST
100
101 return XM_VT_EXT_FIRST + XM_VT_EXT_HW_TIMER;
102 end Alarm_Interrupt_ID;
103
104 ---------------------------
105 -- Clear_Alarm_Interrupt --
106 ---------------------------
107
108 procedure Clear_Alarm_Interrupt is
109 begin
110 -- Interrupts are cleared automatically when they are acknowledged
111
112 null;
113 end Clear_Alarm_Interrupt;
114
115 -----------------------------
116 -- Clear_Interrupt_Request --
117 -----------------------------
118
119 procedure Clear_Interrupt_Request
120 (Interrupt : System.BB.Interrupts.Interrupt_ID)
121 is
122 begin
123 -- Nothing to do for the IPIC
124
125 null;
126 end Clear_Interrupt_Request;
127
128 --------------------------
129 -- Clear_Poke_Interrupt --
130 --------------------------
131
132 procedure Clear_Poke_Interrupt is
133 begin
134 -- Interrupts are cleared automatically when they are acknowledged
135
136 null;
137 end Clear_Poke_Interrupt;
138
139 ---------------------------
140 -- Flush_Windows_Handler --
141 ---------------------------
142
143 procedure Flush_Windows_Handler is
144 begin
145 -- This is the code for the hypercall XM_sparc_flush_regwin. We call it
146 -- this way because this is a macro.
147
148 System.Machine_Code.Asm
149 ("mov 1, %%o0" & ASCII.LF & ASCII.HT & "ta 0xf1",
150 Volatile => True, Clobber => "o0");
151 end Flush_Windows_Handler;
152
153 ----------------------
154 -- Initialize_Board --
155 ----------------------
156
157 procedure Initialize_Board is
158 begin
159 -- Install the trap handler for flushing register windows. This is
160 -- needed for propagating exceptions and for getting tracebacks.
161
162 Install_Trap_Handler
163 (Service_Routine => Flush_Windows_Handler'Address,
164 Vector => Flush_Register_Windows,
165 Synchronous => True);
166 end Initialize_Board;
167
168 ------------------------
169 -- Max_Timer_Interval --
170 ------------------------
171
172 function Max_Timer_Interval return Timer_Interval is
173 begin
174 return Timer_Interval'Last;
175 end Max_Timer_Interval;
176
177 -----------------------
178 -- Poke_Interrupt_ID --
179 -----------------------
180
181 function Poke_Interrupt_ID return Interrupts.Interrupt_ID is
182 begin
183 return 0;
184 end Poke_Interrupt_ID;
185
186 ---------------------------
187 -- Priority_Of_Interrupt --
188 ---------------------------
189
190 function Priority_Of_Interrupt
191 (Interrupt : System.BB.Interrupts.Interrupt_ID) return System.Any_Priority
192 is
193 begin
194 -- Assert that it is a real interrupt
195
196 pragma Assert (Interrupt /= System.BB.Interrupts.No_Interrupt);
197
198 -- Hardware interrupt
199
200 if Interrupt < XM_VT_EXT_FIRST then
201 return (Any_Priority (Interrupt) + Interrupt_Priority'First - 1);
202
203 -- Extended interrupt
204
205 else
206 return System.Any_Priority'Last;
207 end if;
208 end Priority_Of_Interrupt;
209
210 ----------------
211 -- Read_Clock --
212 ----------------
213
214 function Read_Clock return Timer_Interval is
215 XtratuM_Time : aliased XM_Time_T;
216
217 pragma Suppress (Range_Check);
218 -- Suppress this check so we can use a fast implementation for taking
219 -- the lower part of the time (the 32 least significant bits) by simply
220 -- ignoring the most significant part.
221
222 begin
223 Get_Time (XM_HW_CLOCK, XtratuM_Time'Access);
224
225 -- Take the lower 32-bit
226
227 return Timer_Interval (XtratuM_Time);
228 end Read_Clock;
229
230 ---------------
231 -- Set_Alarm --
232 ---------------
233
234 procedure Set_Alarm (Ticks : Timer_Interval) is
235 XtratuM_Time : aliased XM_Time_T;
236
237 begin
238 -- Transform into absolute time
239
240 Get_Time (XM_HW_CLOCK, XtratuM_Time'Access);
241 Set_Timer (XM_HW_CLOCK, XtratuM_Time + XM_Time_T (Ticks), 0);
242
243 if not HW_Timer_Unmasked then
244 Clear_IRQ_Mask (0, 2 ** XM_VT_EXT_HW_TIMER);
245 HW_Timer_Unmasked := True;
246 end if;
247 end Set_Alarm;
248
249 --------------------------
250 -- Set_Current_Priority --
251 --------------------------
252
253 procedure Set_Current_Priority (Priority : Integer) is
254 begin
255 null; -- No board-specific actions necessary
256 end Set_Current_Priority;
257
258 ----------------------
259 -- Ticks_Per_Second --
260 ----------------------
261
262 function Ticks_Per_Second return Natural is
263 begin
264 return Parameters.Clock_Frequency;
265 end Ticks_Per_Second;
266
267 ---------------------------
268 -- Get_Interrupt_Request --
269 ---------------------------
270
271 function Get_Interrupt_Request
272 (Vector : CPU_Primitives.Vector_Id)
273 return System.BB.Interrupts.Interrupt_ID
274 is
275 begin
276 -- The range corresponding to asynchronous traps is 16#11# .. 16#1F#,
277 -- and extended interrupts are 16#E0# .. 16#FF#.
278
279 pragma Assert (Vector in 16#11# .. 16#1F# | 16#E0# .. 16#FF#);
280
281 if Vector in 16#11# .. 16#1F# then
282 return System.BB.Interrupts.Interrupt_ID (Vector - 16#10#);
283 else
284 return System.BB.Interrupts.Interrupt_ID
285 (Vector - 16#E0# + XM_VT_EXT_FIRST);
286 end if;
287 end Get_Interrupt_Request;
288
289 -------------------------------
290 -- Install_Interrupt_Handler --
291 -------------------------------
292
293 procedure Install_Interrupt_Handler
294 (Handler : Address;
295 Interrupt : Interrupts.Interrupt_ID;
296 Prio : Interrupt_Priority)
297 is
298 pragma Unreferenced (Prio);
299 Vec : constant Vector_Id :=
300 (if Interrupt < XM_VT_EXT_FIRST
301 then Vector_Id (Interrupt + 16#10#)
302 else Vector_Id (Interrupt - XM_VT_EXT_FIRST + 16#E0#));
303 begin
304 Install_Trap_Handler (Handler, Vec);
305 end Install_Interrupt_Handler;
306
307 end System.BB.Board_Support;