File : s-bbcaco-leon.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . B B . C A C H E _ C O N T R O L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2010, AdaCore --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 ------------------------------------------------------------------------------
28
29 -- This is the LEON version of this package
30
31 with System.BB.Threads;
32 with System.BB.Threads.Queues;
33 with System.BB.CPU_Primitives; use System.BB.CPU_Primitives;
34 with System.BB.Parameters; use System.BB.Parameters;
35
36 with Ada.Unchecked_Conversion; use Ada;
37
38 package body System.BB.Cache_Control is
39
40 -- As we like to share a single implementation of this
41 -- package between different versions of LEON, we only define
42 -- those bits that actually used and common to all implementations.
43 -- A new port can only use this package if its register definition
44 -- is compatible with the one declared below.
45
46 type Status_2 is mod 2**2;
47 for Status_2'Size use 2;
48
49 type Cache_Control_Register is
50 record
51 Ics : Status_2;
52 Dcs : Status_2;
53 Icf : Boolean;
54 Dcf : Boolean;
55 Fi : Boolean;
56 Fd : Boolean;
57 end record;
58
59 for Cache_Control_Register use
60 record
61 Ics at 0 range 30 .. 31;
62 Dcs at 0 range 28 .. 29;
63 Icf at 0 range 27 .. 27;
64 Dcf at 0 range 26 .. 26;
65 Fi at 0 range 10 .. 10;
66 Fd at 0 range 9 .. 9;
67 end record;
68
69 for Cache_Control_Register'Size use 32;
70 for Cache_Control_Register'Alignment use 4;
71 pragma Suppress_Initialization (Cache_Control_Register);
72
73 type Action_Type is (Disable, Enable, Freeze,
74 Enable_Freeze_Interrupt, Disable_Freeze_Interrupt);
75 -- Actions that can be performed on the cache control register
76
77 procedure Modify_Cache_Register
78 (Register : in out Cache_Control_Register;
79 Cache : Cache_Type;
80 Action : Action_Type);
81 -- Update the required fields in the CCR to enable/disable/freeze the
82 -- requested cache type.
83
84 procedure Modify_Cache_Register
85 (Context : in out Context_Buffer;
86 Index : Context_Id;
87 Cache : Cache_Type;
88 Action : Action_Type);
89 -- Version of Modify_Cache_Register that updates an existing context
90
91 procedure Modify_Cache
92 (Cache : Cache_Type;
93 Action : Action_Type;
94 Partition_Wide : Boolean);
95 -- Update the required fields in the CCR to enable/disable/freeze
96 -- (depending on Action) the requested cache type (depending on Cache)
97 -- for the current task or all (depending on Partition_Wide).
98
99 procedure Set_CCR (Value : Word);
100 pragma Import (Asm, Set_CCR, "set_ccr");
101 -- Set the specified value in the hardware Cache Control Register.
102 -- NOTE: Ideally, this function should use type Cache_Control_Register
103 -- as parameter. We use a simple 32-bit word to pass the parameter
104 -- by value (this is the convention expected by the assembly
105 -- implementation of set_ccr) instead of by reference (as it would
106 -- be the case if the parameter were a structure).
107
108 function Get_CCR return Word;
109 pragma Import (Asm, Get_CCR, "get_ccr");
110 -- Get the value from the hardware Cache Control Register.
111 -- NOTE: Ideally, this function should return a type
112 -- Cache_Control_Register. However, it returns a simple 32-bit word
113 -- to avoid having a function returning a structure. In SPARC, functions
114 -- returning structure, union, or quad-precision values require a more
115 -- complex handshaking mechanism between the caller and the callee (see
116 -- SPARC ABI) that is complicated and inefficient.
117
118 function To_Word is new Unchecked_Conversion (Cache_Control_Register, Word);
119 -- Necessary conversion to store the CCR in the Context
120
121 function To_CCR is new Unchecked_Conversion (Word, Cache_Control_Register);
122 -- Necessary conversion to retrieve the CCR from the Context
123
124 -----------------
125 -- Cache_Flush --
126 -----------------
127
128 procedure Cache_Flush (Cache : Cache_Type) is
129 Tmp_CCR : Cache_Control_Register;
130
131 begin
132 -- Get current value
133
134 Tmp_CCR := To_CCR (Get_CCR);
135
136 -- Set the appropriate bit to 1 to flush the required cache
137
138 case Cache is
139 when Instruction =>
140 Tmp_CCR.Fi := True;
141 when Data =>
142 Tmp_CCR.Fd := True;
143 end case;
144
145 -- Store modified value
146
147 Set_CCR (To_Word (Tmp_CCR));
148 end Cache_Flush;
149
150 ---------------------------------------
151 -- Disable_Cache_Freeze_On_Interrupt --
152 ---------------------------------------
153
154 procedure Disable_Cache_Freeze_On_Interrupt
155 (Cache : Cache_Type;
156 Partition_Wide : Boolean := False)
157 is
158 begin
159 Modify_Cache (Cache, Disable_Freeze_Interrupt, Partition_Wide);
160 end Disable_Cache_Freeze_On_Interrupt;
161
162 --------------------------------------
163 -- Enable_Cache_Freeze_On_Interrupt --
164 --------------------------------------
165
166 procedure Enable_Cache_Freeze_On_Interrupt
167 (Cache : Cache_Type;
168 Partition_Wide : Boolean := False)
169 is
170 begin
171 Modify_Cache (Cache, Enable_Freeze_Interrupt, Partition_Wide);
172 end Enable_Cache_Freeze_On_Interrupt;
173
174 ---------------------
175 -- Get_Cache_State --
176 ---------------------
177
178 function Get_Cache_State (Cache : Cache_Type) return Cache_State is
179 Status : Status_2;
180
181 begin
182 -- Get the requested state
183
184 case Cache is
185 when Instruction =>
186 Status := To_CCR (Get_CCR).Ics;
187 when Data =>
188 Status := To_CCR (Get_CCR).Dcs;
189 end case;
190
191 -- Interpret state
192
193 case Status is
194 when 2#00# | 2#10# =>
195 return Disabled;
196 when 2#11# =>
197 return Enabled;
198 when 2#01# =>
199 return Frozen;
200 end case;
201 end Get_Cache_State;
202
203 ------------------
204 -- Modify_Cache --
205 ------------------
206
207 procedure Modify_Cache
208 (Cache : Cache_Type;
209 Action : Action_Type;
210 Partition_Wide : Boolean)
211 is
212 Tmp_CCR : Cache_Control_Register;
213 Self_Id : constant Threads.Thread_Id := Threads.Thread_Self;
214
215 use type Threads.Thread_Id;
216
217 begin
218 -- Get current value
219
220 Tmp_CCR := To_CCR (Get_CCR);
221
222 -- Update status for the currently executing task
223
224 Modify_Cache_Register (Tmp_CCR, Cache, Action);
225
226 -- Store modified value both in the task buffer and in the actual
227 -- Cache Control Register. The goal of storing the value in the
228 -- base register is to be able to set the desired state when leaving
229 -- from interrupt handlers.
230
231 Modify_Cache_Register
232 (Self_Id.Context, Base_CCR_Context_Index, Cache, Action);
233
234 Set_CCR (To_Word (Tmp_CCR));
235
236 if Partition_Wide then
237
238 -- Update the stored cache control register for all tasks. We modify
239 -- both the base and the actual register to be able to set the
240 -- required state both for the next time the task will execute and
241 -- after the execution of interrupt handlers.
242
243 declare
244 Next_Thread : Threads.Thread_Id;
245
246 begin
247 Next_Thread := Threads.Queues.Global_List;
248 while Next_Thread /= null loop
249 Modify_Cache_Register
250 (Next_Thread.Context, Base_CCR_Context_Index, Cache, Action);
251
252 Modify_Cache_Register
253 (Next_Thread.Context, CCR_Context_Index, Cache, Action);
254
255 Next_Thread := Next_Thread.Global_List;
256 end loop;
257 end;
258 end if;
259 end Modify_Cache;
260
261 ---------------------------
262 -- Modify_Cache_Register --
263 ---------------------------
264
265 procedure Modify_Cache_Register
266 (Register : in out Cache_Control_Register;
267 Cache : Cache_Type;
268 Action : Action_Type)
269 is
270 begin
271 case Action is
272
273 -- For cache control
274
275 when Enable | Disable | Freeze =>
276 declare
277 Value : constant Status_2 :=
278 (if Action = Enable then 2#11#
279 elsif Action = Freeze then 2#01#
280 else 2#00#);
281 begin
282 case Cache is
283 when Instruction =>
284 Register.Ics := Value;
285 when Data =>
286 Register.Dcs := Value;
287 end case;
288 end;
289
290 -- For freeze-on-interrupt
291
292 when Enable_Freeze_Interrupt | Disable_Freeze_Interrupt =>
293 case Cache is
294 when Instruction =>
295 Register.Icf := Action = Enable_Freeze_Interrupt;
296 when Data =>
297 Register.Dcf := Action = Enable_Freeze_Interrupt;
298 end case;
299 end case;
300 end Modify_Cache_Register;
301
302 procedure Modify_Cache_Register
303 (Context : in out Context_Buffer;
304 Index : Context_Id;
305 Cache : Cache_Type;
306 Action : Action_Type)
307 is
308 CCR : Cache_Control_Register := To_CCR (Get_Context (Context, Index));
309 begin
310 Modify_Cache_Register (CCR, Cache, Action);
311 Set_Context (Context, Index, To_Word (CCR));
312 end Modify_Cache_Register;
313
314 ---------------------
315 -- Set_Cache_State --
316 ---------------------
317
318 procedure Set_Cache_State
319 (Cache : Cache_Type;
320 State : Cache_State;
321 Partition_Wide : Boolean := False)
322 is
323 Action : constant Action_Type :=
324 (if State = Disabled then Disable
325 elsif State = Enabled then Enable
326 else Freeze);
327 begin
328 Modify_Cache (Cache, Action, Partition_Wide);
329 end Set_Cache_State;
330
331 end System.BB.Cache_Control;