File : s-bbcppr-arm-xtratum.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-2015, 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 xtratum on tms570A. As Xtratum doesn't provide
32 -- access to fpexc, it is not possible to do lazy save/restore of the fpu.
33
34 with Ada.Unchecked_Conversion; use Ada;
35
36 with System.Storage_Elements;
37 with System.Multiprocessors;
38 with System.BB.Threads;
39 with System.BB.CPU_Primitives.Multiprocessors;
40 with System.BB.Threads.Queues;
41 with System.BB.Board_Support;
42 with System.BB.Protection;
43 with System.BB.Interrupts;
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 pragma Export (C, Trap_Handlers, "__gnat_trap_handlers");
79
80 CPSR_I : constant := 2 ** 7;
81 -- Interrupt disable bit
82
83 procedure GNAT_Error_Handler (Trap : Vector_Id);
84 pragma No_Return (GNAT_Error_Handler);
85
86 procedure Undef_Handler;
87 pragma Machine_Attribute (Undef_Handler, "interrupt");
88 pragma Export (Asm, Undef_Handler, "__gnat_undef_trap");
89
90 procedure Dabt_Handler;
91 pragma Machine_Attribute (Dabt_Handler, "interrupt");
92 pragma Export (Asm, Dabt_Handler, "__gnat_dabt_trap");
93
94 procedure Pabt_Handler;
95 pragma Machine_Attribute (Dabt_Handler, "interrupt");
96 pragma Export (Asm, Pabt_Handler, "__gnat_pabt_trap");
97
98 procedure SVC_Handler;
99 pragma Machine_Attribute (SVC_Handler, "interrupt");
100 pragma Export (Asm, SVC_Handler, "__gnat_svc_trap");
101
102 procedure FIQ_Handler;
103 pragma Machine_Attribute (FIQ_Handler, "interrupt");
104 pragma Export (Asm, FIQ_Handler, "__gnat_fiq_trap");
105
106 ---------------------------
107 -- Context Buffer Layout --
108 ---------------------------
109
110 -- These are the registers that are initialized: program counter, two
111 -- argument registers, program counter, processor state register,
112 -- stack pointer and link register.
113
114 R4 : constant Context_Id := 0;
115 R5 : constant Context_Id := 1;
116 SP : constant Context_Id := 8; -- stack pointer, aka R13
117 LR : constant Context_Id := 9; -- link register, R14
118
119 procedure FPU_Context_Switch (To : Thread_Id) with Inline, Unreferenced;
120 function Get_CPSR return Word with Inline;
121 procedure Set_CPSR (CPSR : Word) with Inline;
122
123 --------------
124 -- Get_CPSR --
125 --------------
126
127 function Get_CPSR return Word is
128 procedure Xm_Arm_Get_Cpsr (Addr : Address);
129 pragma Import (C, Xm_Arm_Get_Cpsr, "XM_arm_get_cpsr");
130
131 CPSR : Word;
132 begin
133 Xm_Arm_Get_Cpsr (CPSR'Address);
134 return CPSR;
135 end Get_CPSR;
136
137 --------------
138 -- Set_CPSR --
139 --------------
140
141 procedure Set_CPSR (CPSR : Word) is
142 procedure Xm_Arm_Set_Cpsr (CPSR : Word);
143 pragma Import (C, Xm_Arm_Set_Cpsr, "XM_arm_set_cpsr");
144 begin
145 Xm_Arm_Set_Cpsr (CPSR);
146 end Set_CPSR;
147
148 ------------------
149 -- Dabt_Handler --
150 ------------------
151
152 procedure Dabt_Handler is
153 begin
154 Trap_Handlers (Data_Abort_Vector) (Data_Abort_Vector);
155 end Dabt_Handler;
156
157 ------------------
158 -- Pabt_Handler --
159 ------------------
160
161 procedure Pabt_Handler is
162 begin
163 Trap_Handlers (Prefetch_Abort_Vector) (Prefetch_Abort_Vector);
164 end Pabt_Handler;
165
166 -------------------
167 -- Undef_Handler --
168 -------------------
169
170 procedure Undef_Handler is
171 begin
172 Trap_Handlers (Undefined_Instruction_Vector)
173 (Undefined_Instruction_Vector);
174 end Undef_Handler;
175
176 -----------------
177 -- SVC_Handler --
178 -----------------
179
180 procedure SVC_Handler is
181 begin
182 Trap_Handlers (Supervisor_Call_Vector)(Supervisor_Call_Vector);
183 end SVC_Handler;
184
185 -----------------
186 -- FIQ_Handler --
187 -----------------
188
189 procedure FIQ_Handler is
190 begin
191 Trap_Handlers (Fast_Interrupt_Request_Vector)
192 (Fast_Interrupt_Request_Vector);
193 end FIQ_Handler;
194
195 --------------------
196 -- Context_Switch --
197 --------------------
198
199 procedure Context_Switch is
200 procedure Asm_Context_Switch;
201 pragma Import (Asm, Asm_Context_Switch, "__gnat_context_switch");
202 begin
203 -- When calling this routine from modes other than user or system,
204 -- the caller is responsible for saving the (banked) SPSR register.
205 -- This register is only visible in banked modes, so can't be saved
206 -- here.
207
208 Asm_Context_Switch;
209 end Context_Switch;
210
211 ------------------------
212 -- FPU_Context_Switch --
213 ------------------------
214
215 procedure FPU_Context_Switch (To : Thread_Id) is
216 C : constant Thread_Id := To;
217
218 Fpscr : Word;
219
220 type Fpu_Context is array (0 .. 31) of Word;
221 Fpu : Fpu_Context;
222 begin
223 if C /= null then
224 Asm (Template => "vstm %1, {d0-d15}" & NL & "fmrx %0, fpscr",
225 Outputs => Word'Asm_Output ("=r", Fpscr),
226 Inputs => Address'Asm_Input ("r", Fpu'Address),
227 Clobber => "memory",
228 Volatile => True);
229 end if;
230
231 if To /= null then
232 Asm (Template => "vldm %1, {d0-d15}" & NL & "fmxr fpscr, %0",
233 Inputs =>
234 (Word'Asm_Input ("r", Fpscr),
235 Address'Asm_Input ("r", Fpu'Address)),
236 Clobber => "memory",
237 Volatile => True);
238 end if;
239 end FPU_Context_Switch;
240
241 -----------------
242 -- Get_Context --
243 -----------------
244
245 function Get_Context
246 (Context : Context_Buffer;
247 Index : Context_Id) return Word
248 is
249 begin
250 return Word (Context (Index));
251 end Get_Context;
252
253 ------------------------
254 -- GNAT_Error_Handler --
255 ------------------------
256
257 procedure GNAT_Error_Handler (Trap : Vector_Id) is
258 begin
259 case Trap is
260 when Reset_Vector =>
261 raise Program_Error with "unexpected reset";
262 when Undefined_Instruction_Vector =>
263 raise Program_Error with "illegal instruction";
264 when Supervisor_Call_Vector =>
265 raise Program_Error with "unhandled SVC";
266 when Prefetch_Abort_Vector =>
267 raise Program_Error with "prefetch abort";
268 when Data_Abort_Vector =>
269 raise Constraint_Error with "data abort";
270 when others =>
271 raise Program_Error with "unhandled trap";
272 end case;
273 end GNAT_Error_Handler;
274
275 -----------------
276 -- Set_Context --
277 -----------------
278
279 procedure Set_Context
280 (Context : in out Context_Buffer;
281 Index : Context_Id;
282 Value : Word)
283 is
284 begin
285 Context (Index) := Address (Value);
286 end Set_Context;
287
288 ------------------------
289 -- Initialize_Context --
290 ------------------------
291
292 procedure Initialize_Context
293 (Buffer : not null access Context_Buffer;
294 Program_Counter : System.Address;
295 Argument : System.Address;
296 Stack_Pointer : System.Address)
297 is
298 procedure Start_Thread;
299 pragma Import (Asm, Start_Thread, "__gnat_start_thread");
300 begin
301 Buffer.all :=
302 (R4 => Argument,
303 R5 => Program_Counter,
304 SP => Stack_Pointer,
305 LR => Start_Thread'Address,
306 others => 0);
307 end Initialize_Context;
308
309 ----------------------------
310 -- Install_Error_Handlers --
311 ----------------------------
312
313 procedure Install_Error_Handlers is
314 EH : constant Address := GNAT_Error_Handler'Address;
315
316 begin
317 Install_Trap_Handler (EH, Reset_Vector);
318 Install_Trap_Handler (EH, Undefined_Instruction_Vector, True);
319 Install_Trap_Handler (EH, Supervisor_Call_Vector, True);
320 Install_Trap_Handler (EH, Prefetch_Abort_Vector, True);
321 Install_Trap_Handler (EH, Data_Abort_Vector);
322
323 -- Do not install a handler for the Interrupt_Request_Vector, as
324 -- the Ravenscar run time will handle that one, and may already
325 -- have installed its handler before calling Install_Error_Handlers.
326
327 Install_Trap_Handler (EH, Fast_Interrupt_Request_Vector);
328 end Install_Error_Handlers;
329
330 --------------------------
331 -- Install_Trap_Handler --
332 --------------------------
333
334 procedure Install_Trap_Handler
335 (Service_Routine : System.Address;
336 Vector : Vector_Id;
337 Synchronous : Boolean := False)
338 is
339 pragma Unreferenced (Synchronous);
340 begin
341 Trap_Handlers (Vector) := To_Pointer (Service_Routine);
342 end Install_Trap_Handler;
343
344 ------------------------
345 -- Disable_Interrupts --
346 ------------------------
347
348 procedure Disable_Interrupts is
349 begin
350 Set_CPSR (Get_CPSR or CPSR_I);
351 end Disable_Interrupts;
352
353 -----------------------
354 -- Enable_Interrupts --
355 -----------------------
356
357 procedure Enable_Interrupts (Level : System.Any_Priority) is
358 begin
359 Board_Support.Set_Current_Priority (Level);
360
361 if Level in System.Priority'Range then
362 Set_CPSR (Get_CPSR and not CPSR_I);
363 end if;
364 end Enable_Interrupts;
365
366 --------------------
367 -- Initialize_CPU --
368 --------------------
369
370 procedure Initialize_CPU is
371 begin
372 null;
373 end Initialize_CPU;
374 end System.BB.CPU_Primitives;