File : s-bbtime-ppc.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . B B . T I M E --
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 -- GNAT 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. GNAT 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 -- GNAT was originally developed by the GNAT team at New York 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 pragma Restrictions (No_Elaboration_Code);
38
39 with System.BB.Interrupts;
40 with System.BB.Board_Support;
41 with System.BB.Protection;
42 with System.BB.Threads.Queues;
43 with System.BB.Timing_Events;
44 with System.BB.CPU_Primitives;
45 with System.BB.CPU_Specific;
46 with System.BB.CPU_Primitives.Multiprocessors;
47 with System.Machine_Code; use System.Machine_Code;
48
49 package body System.BB.Time is
50
51 use Board_Support;
52 use System.Multiprocessors;
53 use System.BB.CPU_Primitives.Multiprocessors;
54
55 -- We use two timers with the same frequency:
56 -- A Periodic Timer for the clock
57 -- An Alarm Timer for delays
58
59 -----------------------
60 -- Local Definitions --
61 -----------------------
62
63 type Unsigned_32 is mod 2 ** 32;
64 for Unsigned_32'Size use 32;
65 -- Values of this type represent number of times that the clock finishes
66 -- its countdown. This type should allow atomic reads and updates.
67
68 -----------------------
69 -- Local Subprograms --
70 -----------------------
71
72 procedure Alarm_Handler (Interrupt : Interrupts.Interrupt_ID);
73 -- Handler for the alarm interrupt
74
75 procedure Set_DEC (Ticks : Unsigned_32);
76 pragma Inline (Set_DEC);
77 -- Set the decrementer register
78
79 function Read_TBL return Unsigned_32;
80 pragma Inline (Read_TBL);
81 -- Read the Time Base Lower word
82
83 function Read_TBU return Unsigned_32;
84 pragma Inline (Read_TBU);
85 -- Read the Time Base Upper word
86
87 -------------------
88 -- Alarm_Handler --
89 -------------------
90
91 procedure Alarm_Handler (Interrupt : Interrupts.Interrupt_ID) is
92 pragma Unreferenced (Interrupt);
93
94 Now : constant Time := Clock;
95 CPU_Id : constant CPU := Current_CPU;
96
97 begin
98 Board_Support.Clear_Alarm_Interrupt;
99
100 -- A context switch may happen due to an awaken task. Charge the
101 -- current task.
102
103 if Scheduling_Event_Hook /= null then
104 Scheduling_Event_Hook.all;
105 end if;
106
107 -- Note that the code is executed with interruptions disabled, so there
108 -- is no need to call Enter_Kernel/Leave_Kernel.
109
110 -- Execute expired events of the current CPU
111
112 Timing_Events.Execute_Expired_Timing_Events (Now);
113
114 -- Wake up our alarms
115
116 Threads.Queues.Wakeup_Expired_Alarms (Now);
117
118 -- Set the timer for the next alarm on this CPU
119
120 Update_Alarm (Get_Next_Timeout (CPU_Id));
121
122 -- The interrupt low-level handler will call context_switch if necessary
123
124 end Alarm_Handler;
125
126 -----------
127 -- Clock --
128 -----------
129
130 function Clock return Time is
131 Lo : Unsigned_32;
132 Hi : Unsigned_32;
133 Hi1 : Unsigned_32;
134
135 begin
136 -- We can't atomically read the 64-bits counter. So check that the
137 -- 32 MSB don't change.
138
139 Hi := Read_TBU;
140 loop
141 Lo := Read_TBL;
142 Hi1 := Read_TBU;
143 exit when Hi = Hi1;
144 Hi := Hi1;
145 end loop;
146
147 return (Time (Hi) * 2 ** 32) + Time (Lo);
148 end Clock;
149
150 -----------
151 -- Epoch --
152 -----------
153
154 function Epoch return Time is
155 begin
156 -- TBL and TBU cleared at start up
157
158 return 0;
159 end Epoch;
160
161 -----------------
162 -- Delay_Until --
163 -----------------
164
165 procedure Delay_Until (T : Time) is
166 Now : Time;
167 Self : Threads.Thread_Id;
168 Inserted_As_First : Boolean;
169 CPU_Id : constant CPU := Current_CPU;
170
171 begin
172 -- First mask interrupts, this is necessary to handle thread queues
173
174 Protection.Enter_Kernel;
175
176 -- Read the clock once the interrupts are masked to avoid being
177 -- interrupted before the alarm is set.
178
179 Now := Clock;
180
181 Self := Threads.Thread_Self;
182
183 -- Test if the alarm time is in the future
184
185 if T > Now then
186
187 -- Extract the thread from the ready queue. When a thread wants to
188 -- wait for an alarm it becomes blocked.
189
190 Self.State := Threads.Delayed;
191
192 Threads.Queues.Extract (Self);
193
194 -- Insert Thread_Id in the alarm queue (ordered by time) and if it
195 -- was inserted at head then check if Alarm Time is closer than the
196 -- next clock interrupt.
197
198 Threads.Queues.Insert_Alarm (T, Self, Inserted_As_First);
199
200 if Inserted_As_First then
201 Update_Alarm (Get_Next_Timeout (CPU_Id));
202 end if;
203
204 else
205 -- If alarm time is not in the future, the thread must yield the CPU
206
207 Threads.Queues.Yield (Self);
208 end if;
209
210 Protection.Leave_Kernel;
211 end Delay_Until;
212
213 ----------------------
214 -- Get_Next_Timeout --
215 ----------------------
216
217 function Get_Next_Timeout (CPU_Id : CPU) return Time is
218 Alarm_Time : constant Time :=
219 Threads.Queues.Get_Next_Alarm_Time (CPU_Id);
220 Event_Time : constant Time := Timing_Events.Get_Next_Timeout (CPU_Id);
221
222 begin
223 if Alarm_Time <= Event_Time then
224 return Alarm_Time;
225 else
226 return Event_Time;
227 end if;
228 end Get_Next_Timeout;
229
230 -----------------------
231 -- Initialize_Timers --
232 -----------------------
233
234 procedure Initialize_Timers is
235 begin
236 -- Install alarm handler
237
238 CPU_Specific.Install_Exception_Handler
239 (Alarm_Handler'Address, CPU_Specific.Decrementer_Excp);
240 end Initialize_Timers;
241
242 --------------
243 -- Read_TBL --
244 --------------
245
246 function Read_TBL return Unsigned_32 is
247 Res : Unsigned_32;
248 begin
249 Asm ("mftbl %0",
250 Outputs => Unsigned_32'Asm_Output ("=r", Res),
251 Volatile => True);
252 return Res;
253 end Read_TBL;
254
255 --------------
256 -- Read_TBU --
257 --------------
258
259 function Read_TBU return Unsigned_32 is
260 Res : Unsigned_32;
261 begin
262 Asm ("mftbu %0",
263 Outputs => Unsigned_32'Asm_Output ("=r", Res),
264 Volatile => True);
265 return Res;
266 end Read_TBU;
267
268 -------------
269 -- Set_DEC --
270 -------------
271
272 procedure Set_DEC (Ticks : Unsigned_32) is
273 begin
274 Asm ("mtdec %0",
275 Inputs => Unsigned_32'Asm_Input ("r", Ticks),
276 Volatile => True);
277 end Set_DEC;
278
279 ------------------
280 -- Update_Alarm --
281 ------------------
282
283 procedure Update_Alarm (Alarm : Time) is
284 Max_Timer_Interval : constant Unsigned_32 := 16#7FFF_FFFF#;
285 -- The maximum value that can be set in the DEC register. MSB must not
286 -- be set to avoid a useless interrupt (PowerPC triggers an interrupt
287 -- when the MSB switches from 0 to 1).
288
289 Now : constant Time := Clock;
290
291 Diff : constant Time := (if Alarm > Now then Alarm - Now else 1);
292 -- If alarm is in the past (it may happen because we are getting the
293 -- clock value again here), set the minimum timer value so the interrupt
294 -- will be triggered as soon as possible. Note that we cannot get
295 -- the difference first and then check whether the result is negative
296 -- because type Time is modular. On e500, we must set 1 to trigger an
297 -- exception.
298
299 Dec : Unsigned_32;
300
301 begin
302
303 -- Check whether the alarm time is within the DEC period
304
305 if Diff <= Time (Max_Timer_Interval) then
306 Dec := Unsigned_32 (Diff);
307 else
308 Dec := Max_Timer_Interval;
309 end if;
310
311 Set_DEC (Dec);
312 end Update_Alarm;
313
314 end System.BB.Time;