File : s-taprop-dummy.adb
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 -- --
9 -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
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 -- --
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 -- 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;