|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNARL 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 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
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 -- GNARL was developed by the GNARL team at Florida State University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 -- This is a no tasking version of this package
|
|
|
33
|
|
|
34 -- This package contains all the GNULL primitives that interface directly with
|
|
|
35 -- the underlying OS.
|
|
|
36
|
|
|
37 pragma Polling (Off);
|
|
|
38 -- Turn off polling, we do not want ATC polling to take place during tasking
|
|
|
39 -- operations. It causes infinite loops and other problems.
|
|
|
40
|
|
|
41 package body System.Task_Primitives.Operations is
|
|
|
42
|
|
|
43 use System.Tasking;
|
|
|
44 use System.Parameters;
|
|
|
45
|
|
|
46 pragma Warnings (Off);
|
|
|
47 -- Turn off warnings since so many unreferenced parameters
|
|
|
48
|
|
|
49 --------------
|
|
|
50 -- Specific --
|
|
|
51 --------------
|
|
|
52
|
|
|
53 -- Package Specific contains target specific routines, and the body of
|
|
|
54 -- this package is target specific.
|
|
|
55
|
|
|
56 package Specific is
|
|
|
57 procedure Set (Self_Id : Task_Id);
|
|
|
58 pragma Inline (Set);
|
|
|
59 -- Set the self id for the current task
|
|
|
60 end Specific;
|
|
|
61
|
|
|
62 package body Specific is
|
|
|
63
|
|
|
64 ---------
|
|
|
65 -- Set --
|
|
|
66 ---------
|
|
|
67
|
|
|
68 procedure Set (Self_Id : Task_Id) is
|
|
|
69 begin
|
|
|
70 null;
|
|
|
71 end Set;
|
|
|
72 end Specific;
|
|
|
73
|
|
|
74 ----------------------------------
|
|
|
75 -- ATCB allocation/deallocation --
|
|
|
76 ----------------------------------
|
|
|
77
|
|
|
78 package body ATCB_Allocation is separate;
|
|
|
79 -- The body of this package is shared across several targets
|
|
|
80
|
|
|
81 ----------------
|
|
|
82 -- Abort_Task --
|
|
|
83 ----------------
|
|
|
84
|
|
|
85 procedure Abort_Task (T : Task_Id) is
|
|
|
86 begin
|
|
|
87 null;
|
|
|
88 end Abort_Task;
|
|
|
89
|
|
|
90 ----------------
|
|
|
91 -- Check_Exit --
|
|
|
92 ----------------
|
|
|
93
|
|
|
94 function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
|
|
|
95 begin
|
|
|
96 return True;
|
|
|
97 end Check_Exit;
|
|
|
98
|
|
|
99 --------------------
|
|
|
100 -- Check_No_Locks --
|
|
|
101 --------------------
|
|
|
102
|
|
|
103 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
|
|
|
104 begin
|
|
|
105 return True;
|
|
|
106 end Check_No_Locks;
|
|
|
107
|
|
|
108 -------------------
|
|
|
109 -- Continue_Task --
|
|
|
110 -------------------
|
|
|
111
|
|
|
112 function Continue_Task (T : ST.Task_Id) return Boolean is
|
|
|
113 begin
|
|
|
114 return False;
|
|
|
115 end Continue_Task;
|
|
|
116
|
|
|
117 -------------------
|
|
|
118 -- Current_State --
|
|
|
119 -------------------
|
|
|
120
|
|
|
121 function Current_State (S : Suspension_Object) return Boolean is
|
|
|
122 begin
|
|
|
123 return False;
|
|
|
124 end Current_State;
|
|
|
125
|
|
|
126 ----------------------
|
|
|
127 -- Environment_Task --
|
|
|
128 ----------------------
|
|
|
129
|
|
|
130 function Environment_Task return Task_Id is
|
|
|
131 begin
|
|
|
132 return null;
|
|
|
133 end Environment_Task;
|
|
|
134
|
|
|
135 -----------------
|
|
|
136 -- Create_Task --
|
|
|
137 -----------------
|
|
|
138
|
|
|
139 procedure Create_Task
|
|
|
140 (T : Task_Id;
|
|
|
141 Wrapper : System.Address;
|
|
|
142 Stack_Size : System.Parameters.Size_Type;
|
|
|
143 Priority : System.Any_Priority;
|
|
|
144 Succeeded : out Boolean)
|
|
|
145 is
|
|
|
146 begin
|
|
|
147 Succeeded := False;
|
|
|
148 end Create_Task;
|
|
|
149
|
|
|
150 ----------------
|
|
|
151 -- Enter_Task --
|
|
|
152 ----------------
|
|
|
153
|
|
|
154 procedure Enter_Task (Self_ID : Task_Id) is
|
|
|
155 begin
|
|
|
156 null;
|
|
|
157 end Enter_Task;
|
|
|
158
|
|
|
159 ---------------
|
|
|
160 -- Exit_Task --
|
|
|
161 ---------------
|
|
|
162
|
|
|
163 procedure Exit_Task is
|
|
|
164 begin
|
|
|
165 null;
|
|
|
166 end Exit_Task;
|
|
|
167
|
|
|
168 --------------
|
|
|
169 -- Finalize --
|
|
|
170 --------------
|
|
|
171
|
|
|
172 procedure Finalize (S : in out Suspension_Object) is
|
|
|
173 begin
|
|
|
174 null;
|
|
|
175 end Finalize;
|
|
|
176
|
|
|
177 -------------------
|
|
|
178 -- Finalize_Lock --
|
|
|
179 -------------------
|
|
|
180
|
|
|
181 procedure Finalize_Lock (L : not null access Lock) is
|
|
|
182 begin
|
|
|
183 null;
|
|
|
184 end Finalize_Lock;
|
|
|
185
|
|
|
186 procedure Finalize_Lock (L : not null access RTS_Lock) is
|
|
|
187 begin
|
|
|
188 null;
|
|
|
189 end Finalize_Lock;
|
|
|
190
|
|
|
191 ------------------
|
|
|
192 -- Finalize_TCB --
|
|
|
193 ------------------
|
|
|
194
|
|
|
195 procedure Finalize_TCB (T : Task_Id) is
|
|
|
196 begin
|
|
|
197 null;
|
|
|
198 end Finalize_TCB;
|
|
|
199
|
|
|
200 ------------------
|
|
|
201 -- Get_Priority --
|
|
|
202 ------------------
|
|
|
203
|
|
|
204 function Get_Priority (T : Task_Id) return System.Any_Priority is
|
|
|
205 begin
|
|
|
206 return 0;
|
|
|
207 end Get_Priority;
|
|
|
208
|
|
|
209 --------------------
|
|
|
210 -- Get_Thread_Id --
|
|
|
211 --------------------
|
|
|
212
|
|
|
213 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
|
|
|
214 begin
|
|
|
215 return OSI.Thread_Id (T.Common.LL.Thread);
|
|
|
216 end Get_Thread_Id;
|
|
|
217
|
|
|
218 ----------------
|
|
|
219 -- Initialize --
|
|
|
220 ----------------
|
|
|
221
|
|
|
222 procedure Initialize (Environment_Task : Task_Id) is
|
|
|
223 No_Tasking : Boolean;
|
|
|
224 begin
|
|
|
225 raise Program_Error with "tasking not implemented on this configuration";
|
|
|
226 end Initialize;
|
|
|
227
|
|
|
228 procedure Initialize (S : in out Suspension_Object) is
|
|
|
229 begin
|
|
|
230 null;
|
|
|
231 end Initialize;
|
|
|
232
|
|
|
233 ---------------------
|
|
|
234 -- Initialize_Lock --
|
|
|
235 ---------------------
|
|
|
236
|
|
|
237 procedure Initialize_Lock
|
|
|
238 (Prio : System.Any_Priority;
|
|
|
239 L : not null access Lock)
|
|
|
240 is
|
|
|
241 begin
|
|
|
242 null;
|
|
|
243 end Initialize_Lock;
|
|
|
244
|
|
|
245 procedure Initialize_Lock
|
|
|
246 (L : not null access RTS_Lock; Level : Lock_Level) is
|
|
|
247 begin
|
|
|
248 null;
|
|
|
249 end Initialize_Lock;
|
|
|
250
|
|
|
251 --------------------
|
|
|
252 -- Initialize_TCB --
|
|
|
253 --------------------
|
|
|
254
|
|
|
255 procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
|
|
|
256 begin
|
|
|
257 Succeeded := False;
|
|
|
258 end Initialize_TCB;
|
|
|
259
|
|
|
260 -------------------
|
|
|
261 -- Is_Valid_Task --
|
|
|
262 -------------------
|
|
|
263
|
|
|
264 function Is_Valid_Task return Boolean is
|
|
|
265 begin
|
|
|
266 return False;
|
|
|
267 end Is_Valid_Task;
|
|
|
268
|
|
|
269 --------------
|
|
|
270 -- Lock_RTS --
|
|
|
271 --------------
|
|
|
272
|
|
|
273 procedure Lock_RTS is
|
|
|
274 begin
|
|
|
275 null;
|
|
|
276 end Lock_RTS;
|
|
|
277
|
|
|
278 ---------------------
|
|
|
279 -- Monotonic_Clock --
|
|
|
280 ---------------------
|
|
|
281
|
|
|
282 function Monotonic_Clock return Duration is
|
|
|
283 begin
|
|
|
284 return 0.0;
|
|
|
285 end Monotonic_Clock;
|
|
|
286
|
|
|
287 ---------------
|
|
|
288 -- Read_Lock --
|
|
|
289 ---------------
|
|
|
290
|
|
|
291 procedure Read_Lock
|
|
|
292 (L : not null access Lock;
|
|
|
293 Ceiling_Violation : out Boolean)
|
|
|
294 is
|
|
|
295 begin
|
|
|
296 Ceiling_Violation := False;
|
|
|
297 end Read_Lock;
|
|
|
298
|
|
|
299 -----------------------------
|
|
|
300 -- Register_Foreign_Thread --
|
|
|
301 -----------------------------
|
|
|
302
|
|
|
303 function Register_Foreign_Thread return Task_Id is
|
|
|
304 begin
|
|
|
305 return null;
|
|
|
306 end Register_Foreign_Thread;
|
|
|
307
|
|
|
308 -----------------
|
|
|
309 -- Resume_Task --
|
|
|
310 -----------------
|
|
|
311
|
|
|
312 function Resume_Task
|
|
|
313 (T : ST.Task_Id;
|
|
|
314 Thread_Self : OSI.Thread_Id) return Boolean
|
|
|
315 is
|
|
|
316 begin
|
|
|
317 return False;
|
|
|
318 end Resume_Task;
|
|
|
319
|
|
|
320 -------------------
|
|
|
321 -- RT_Resolution --
|
|
|
322 -------------------
|
|
|
323
|
|
|
324 function RT_Resolution return Duration is
|
|
|
325 begin
|
|
|
326 return 10#1.0#E-6;
|
|
|
327 end RT_Resolution;
|
|
|
328
|
|
|
329 ----------
|
|
|
330 -- Self --
|
|
|
331 ----------
|
|
|
332
|
|
|
333 function Self return Task_Id is
|
|
|
334 begin
|
|
|
335 return Null_Task;
|
|
|
336 end Self;
|
|
|
337
|
|
|
338 -----------------
|
|
|
339 -- Set_Ceiling --
|
|
|
340 -----------------
|
|
|
341
|
|
|
342 procedure Set_Ceiling
|
|
|
343 (L : not null access Lock;
|
|
|
344 Prio : System.Any_Priority)
|
|
|
345 is
|
|
|
346 begin
|
|
|
347 null;
|
|
|
348 end Set_Ceiling;
|
|
|
349
|
|
|
350 ---------------
|
|
|
351 -- Set_False --
|
|
|
352 ---------------
|
|
|
353
|
|
|
354 procedure Set_False (S : in out Suspension_Object) is
|
|
|
355 begin
|
|
|
356 null;
|
|
|
357 end Set_False;
|
|
|
358
|
|
|
359 ------------------
|
|
|
360 -- Set_Priority --
|
|
|
361 ------------------
|
|
|
362
|
|
|
363 procedure Set_Priority
|
|
|
364 (T : Task_Id;
|
|
|
365 Prio : System.Any_Priority;
|
|
|
366 Loss_Of_Inheritance : Boolean := False)
|
|
|
367 is
|
|
|
368 begin
|
|
|
369 null;
|
|
|
370 end Set_Priority;
|
|
|
371
|
|
|
372 -----------------------
|
|
|
373 -- Set_Task_Affinity --
|
|
|
374 -----------------------
|
|
|
375
|
|
|
376 procedure Set_Task_Affinity (T : ST.Task_Id) is
|
|
|
377 begin
|
|
|
378 null;
|
|
|
379 end Set_Task_Affinity;
|
|
|
380
|
|
|
381 --------------
|
|
|
382 -- Set_True --
|
|
|
383 --------------
|
|
|
384
|
|
|
385 procedure Set_True (S : in out Suspension_Object) is
|
|
|
386 begin
|
|
|
387 null;
|
|
|
388 end Set_True;
|
|
|
389
|
|
|
390 -----------
|
|
|
391 -- Sleep --
|
|
|
392 -----------
|
|
|
393
|
|
|
394 procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
|
|
|
395 begin
|
|
|
396 null;
|
|
|
397 end Sleep;
|
|
|
398
|
|
|
399 -----------------
|
|
|
400 -- Stack_Guard --
|
|
|
401 -----------------
|
|
|
402
|
|
|
403 procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
|
|
|
404 begin
|
|
|
405 null;
|
|
|
406 end Stack_Guard;
|
|
|
407
|
|
|
408 ------------------
|
|
|
409 -- Suspend_Task --
|
|
|
410 ------------------
|
|
|
411
|
|
|
412 function Suspend_Task
|
|
|
413 (T : ST.Task_Id;
|
|
|
414 Thread_Self : OSI.Thread_Id) return Boolean
|
|
|
415 is
|
|
|
416 begin
|
|
|
417 return False;
|
|
|
418 end Suspend_Task;
|
|
|
419
|
|
|
420 --------------------
|
|
|
421 -- Stop_All_Tasks --
|
|
|
422 --------------------
|
|
|
423
|
|
|
424 procedure Stop_All_Tasks is
|
|
|
425 begin
|
|
|
426 null;
|
|
|
427 end Stop_All_Tasks;
|
|
|
428
|
|
|
429 ---------------
|
|
|
430 -- Stop_Task --
|
|
|
431 ---------------
|
|
|
432
|
|
|
433 function Stop_Task (T : ST.Task_Id) return Boolean is
|
|
|
434 pragma Unreferenced (T);
|
|
|
435 begin
|
|
|
436 return False;
|
|
|
437 end Stop_Task;
|
|
|
438
|
|
|
439 ------------------------
|
|
|
440 -- Suspend_Until_True --
|
|
|
441 ------------------------
|
|
|
442
|
|
|
443 procedure Suspend_Until_True (S : in out Suspension_Object) is
|
|
|
444 begin
|
|
|
445 null;
|
|
|
446 end Suspend_Until_True;
|
|
|
447
|
|
|
448 -----------------
|
|
|
449 -- Timed_Delay --
|
|
|
450 -----------------
|
|
|
451
|
|
|
452 procedure Timed_Delay
|
|
|
453 (Self_ID : Task_Id;
|
|
|
454 Time : Duration;
|
|
|
455 Mode : ST.Delay_Modes)
|
|
|
456 is
|
|
|
457 begin
|
|
|
458 null;
|
|
|
459 end Timed_Delay;
|
|
|
460
|
|
|
461 -----------------
|
|
|
462 -- Timed_Sleep --
|
|
|
463 -----------------
|
|
|
464
|
|
|
465 procedure Timed_Sleep
|
|
|
466 (Self_ID : Task_Id;
|
|
|
467 Time : Duration;
|
|
|
468 Mode : ST.Delay_Modes;
|
|
|
469 Reason : System.Tasking.Task_States;
|
|
|
470 Timedout : out Boolean;
|
|
|
471 Yielded : out Boolean)
|
|
|
472 is
|
|
|
473 begin
|
|
|
474 Timedout := False;
|
|
|
475 Yielded := False;
|
|
|
476 end Timed_Sleep;
|
|
|
477
|
|
|
478 ------------
|
|
|
479 -- Unlock --
|
|
|
480 ------------
|
|
|
481
|
|
|
482 procedure Unlock (L : not null access Lock) is
|
|
|
483 begin
|
|
|
484 null;
|
|
|
485 end Unlock;
|
|
|
486
|
|
|
487 procedure Unlock
|
|
|
488 (L : not null access RTS_Lock;
|
|
|
489 Global_Lock : Boolean := False)
|
|
|
490 is
|
|
|
491 begin
|
|
|
492 null;
|
|
|
493 end Unlock;
|
|
|
494
|
|
|
495 procedure Unlock (T : Task_Id) is
|
|
|
496 begin
|
|
|
497 null;
|
|
|
498 end Unlock;
|
|
|
499
|
|
|
500 ----------------
|
|
|
501 -- Unlock_RTS --
|
|
|
502 ----------------
|
|
|
503
|
|
|
504 procedure Unlock_RTS is
|
|
|
505 begin
|
|
|
506 null;
|
|
|
507 end Unlock_RTS;
|
|
|
508 ------------
|
|
|
509 -- Wakeup --
|
|
|
510 ------------
|
|
|
511
|
|
|
512 procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
|
|
|
513 begin
|
|
|
514 null;
|
|
|
515 end Wakeup;
|
|
|
516
|
|
|
517 ----------------
|
|
|
518 -- Write_Lock --
|
|
|
519 ----------------
|
|
|
520
|
|
|
521 procedure Write_Lock
|
|
|
522 (L : not null access Lock;
|
|
|
523 Ceiling_Violation : out Boolean)
|
|
|
524 is
|
|
|
525 begin
|
|
|
526 Ceiling_Violation := False;
|
|
|
527 end Write_Lock;
|
|
|
528
|
|
|
529 procedure Write_Lock
|
|
|
530 (L : not null access RTS_Lock;
|
|
|
531 Global_Lock : Boolean := False)
|
|
|
532 is
|
|
|
533 begin
|
|
|
534 null;
|
|
|
535 end Write_Lock;
|
|
|
536
|
|
|
537 procedure Write_Lock (T : Task_Id) is
|
|
|
538 begin
|
|
|
539 null;
|
|
|
540 end Write_Lock;
|
|
|
541
|
|
|
542 -----------
|
|
|
543 -- Yield --
|
|
|
544 -----------
|
|
|
545
|
|
|
546 procedure Yield (Do_Yield : Boolean := True) is
|
|
|
547 begin
|
|
|
548 null;
|
|
|
549 end Yield;
|
|
|
550
|
|
|
551 end System.Task_Primitives.Operations;
|
