PR testsuite/44195
[official-gcc.git] / gcc / ada / s-taprop-dummy.adb
blob645e9fd90bae03a7fc9e373a95ec6610e223ece5
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-2009, 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 -- 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 ------------------------------------------------------------------------------
32 -- This is a no tasking version of this package
34 -- This package contains all the GNULL primitives that interface directly with
35 -- the underlying OS.
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.
41 package body System.Task_Primitives.Operations is
43 use System.Tasking;
44 use System.Parameters;
46 pragma Warnings (Off);
47 -- Turn off warnings since so many unreferenced parameters
49 ----------------
50 -- Abort_Task --
51 ----------------
53 procedure Abort_Task (T : Task_Id) is
54 begin
55 null;
56 end Abort_Task;
58 ----------------
59 -- Check_Exit --
60 ----------------
62 function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
63 begin
64 return True;
65 end Check_Exit;
67 --------------------
68 -- Check_No_Locks --
69 --------------------
71 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
72 begin
73 return True;
74 end Check_No_Locks;
76 -------------------
77 -- Continue_Task --
78 -------------------
80 function Continue_Task (T : ST.Task_Id) return Boolean is
81 begin
82 return False;
83 end Continue_Task;
85 -------------------
86 -- Current_State --
87 -------------------
89 function Current_State (S : Suspension_Object) return Boolean is
90 begin
91 return False;
92 end Current_State;
94 ----------------------
95 -- Environment_Task --
96 ----------------------
98 function Environment_Task return Task_Id is
99 begin
100 return null;
101 end Environment_Task;
103 -----------------
104 -- Create_Task --
105 -----------------
107 procedure Create_Task
108 (T : Task_Id;
109 Wrapper : System.Address;
110 Stack_Size : System.Parameters.Size_Type;
111 Priority : System.Any_Priority;
112 Succeeded : out Boolean)
114 begin
115 Succeeded := False;
116 end Create_Task;
118 ----------------
119 -- Enter_Task --
120 ----------------
122 procedure Enter_Task (Self_ID : Task_Id) is
123 begin
124 null;
125 end Enter_Task;
127 ---------------
128 -- Exit_Task --
129 ---------------
131 procedure Exit_Task is
132 begin
133 null;
134 end Exit_Task;
136 --------------
137 -- Finalize --
138 --------------
140 procedure Finalize (S : in out Suspension_Object) is
141 begin
142 null;
143 end Finalize;
145 -------------------
146 -- Finalize_Lock --
147 -------------------
149 procedure Finalize_Lock (L : not null access Lock) is
150 begin
151 null;
152 end Finalize_Lock;
154 procedure Finalize_Lock (L : not null access RTS_Lock) is
155 begin
156 null;
157 end Finalize_Lock;
159 ------------------
160 -- Finalize_TCB --
161 ------------------
163 procedure Finalize_TCB (T : Task_Id) is
164 begin
165 null;
166 end Finalize_TCB;
168 ------------------
169 -- Get_Priority --
170 ------------------
172 function Get_Priority (T : Task_Id) return System.Any_Priority is
173 begin
174 return 0;
175 end Get_Priority;
177 --------------------
178 -- Get_Thread_Id --
179 --------------------
181 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
182 begin
183 return OSI.Thread_Id (T.Common.LL.Thread);
184 end Get_Thread_Id;
186 ----------------
187 -- Initialize --
188 ----------------
190 procedure Initialize (Environment_Task : Task_Id) is
191 No_Tasking : Boolean;
192 begin
193 raise Program_Error with "tasking not implemented on this configuration";
194 end Initialize;
196 procedure Initialize (S : in out Suspension_Object) is
197 begin
198 null;
199 end Initialize;
201 ---------------------
202 -- Initialize_Lock --
203 ---------------------
205 procedure Initialize_Lock
206 (Prio : System.Any_Priority;
207 L : not null access Lock)
209 begin
210 null;
211 end Initialize_Lock;
213 procedure Initialize_Lock
214 (L : not null access RTS_Lock; Level : Lock_Level) is
215 begin
216 null;
217 end Initialize_Lock;
219 --------------------
220 -- Initialize_TCB --
221 --------------------
223 procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
224 begin
225 Succeeded := False;
226 end Initialize_TCB;
228 -------------------
229 -- Is_Valid_Task --
230 -------------------
232 function Is_Valid_Task return Boolean is
233 begin
234 return False;
235 end Is_Valid_Task;
237 --------------
238 -- Lock_RTS --
239 --------------
241 procedure Lock_RTS is
242 begin
243 null;
244 end Lock_RTS;
246 ---------------------
247 -- Monotonic_Clock --
248 ---------------------
250 function Monotonic_Clock return Duration is
251 begin
252 return 0.0;
253 end Monotonic_Clock;
255 --------------
256 -- New_ATCB --
257 --------------
259 function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
260 begin
261 return new Ada_Task_Control_Block (Entry_Num);
262 end New_ATCB;
264 ---------------
265 -- Read_Lock --
266 ---------------
268 procedure Read_Lock
269 (L : not null access Lock;
270 Ceiling_Violation : out Boolean)
272 begin
273 Ceiling_Violation := False;
274 end Read_Lock;
276 -----------------------------
277 -- Register_Foreign_Thread --
278 -----------------------------
280 function Register_Foreign_Thread return Task_Id is
281 begin
282 return null;
283 end Register_Foreign_Thread;
285 -----------------
286 -- Resume_Task --
287 -----------------
289 function Resume_Task
290 (T : ST.Task_Id;
291 Thread_Self : OSI.Thread_Id) return Boolean
293 begin
294 return False;
295 end Resume_Task;
297 -------------------
298 -- RT_Resolution --
299 -------------------
301 function RT_Resolution return Duration is
302 begin
303 return 10#1.0#E-6;
304 end RT_Resolution;
306 ----------
307 -- Self --
308 ----------
310 function Self return Task_Id is
311 begin
312 return Null_Task;
313 end Self;
315 -----------------
316 -- Set_Ceiling --
317 -----------------
319 procedure Set_Ceiling
320 (L : not null access Lock;
321 Prio : System.Any_Priority)
323 begin
324 null;
325 end Set_Ceiling;
327 ---------------
328 -- Set_False --
329 ---------------
331 procedure Set_False (S : in out Suspension_Object) is
332 begin
333 null;
334 end Set_False;
336 ------------------
337 -- Set_Priority --
338 ------------------
340 procedure Set_Priority
341 (T : Task_Id;
342 Prio : System.Any_Priority;
343 Loss_Of_Inheritance : Boolean := False)
345 begin
346 null;
347 end Set_Priority;
349 --------------
350 -- Set_True --
351 --------------
353 procedure Set_True (S : in out Suspension_Object) is
354 begin
355 null;
356 end Set_True;
358 -----------
359 -- Sleep --
360 -----------
362 procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
363 begin
364 null;
365 end Sleep;
367 -----------------
368 -- Stack_Guard --
369 -----------------
371 procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
372 begin
373 null;
374 end Stack_Guard;
376 ------------------
377 -- Suspend_Task --
378 ------------------
380 function Suspend_Task
381 (T : ST.Task_Id;
382 Thread_Self : OSI.Thread_Id) return Boolean
384 begin
385 return False;
386 end Suspend_Task;
388 --------------------
389 -- Stop_All_Tasks --
390 --------------------
392 procedure Stop_All_Tasks is
393 begin
394 null;
395 end Stop_All_Tasks;
397 ---------------
398 -- Stop_Task --
399 ---------------
401 function Stop_Task (T : ST.Task_Id) return Boolean is
402 pragma Unreferenced (T);
403 begin
404 return False;
405 end Stop_Task;
407 ------------------------
408 -- Suspend_Until_True --
409 ------------------------
411 procedure Suspend_Until_True (S : in out Suspension_Object) is
412 begin
413 null;
414 end Suspend_Until_True;
416 -----------------
417 -- Timed_Delay --
418 -----------------
420 procedure Timed_Delay
421 (Self_ID : Task_Id;
422 Time : Duration;
423 Mode : ST.Delay_Modes)
425 begin
426 null;
427 end Timed_Delay;
429 -----------------
430 -- Timed_Sleep --
431 -----------------
433 procedure Timed_Sleep
434 (Self_ID : Task_Id;
435 Time : Duration;
436 Mode : ST.Delay_Modes;
437 Reason : System.Tasking.Task_States;
438 Timedout : out Boolean;
439 Yielded : out Boolean)
441 begin
442 Timedout := False;
443 Yielded := False;
444 end Timed_Sleep;
446 ------------
447 -- Unlock --
448 ------------
450 procedure Unlock (L : not null access Lock) is
451 begin
452 null;
453 end Unlock;
455 procedure Unlock
456 (L : not null access RTS_Lock;
457 Global_Lock : Boolean := False)
459 begin
460 null;
461 end Unlock;
463 procedure Unlock (T : Task_Id) is
464 begin
465 null;
466 end Unlock;
468 ----------------
469 -- Unlock_RTS --
470 ----------------
472 procedure Unlock_RTS is
473 begin
474 null;
475 end Unlock_RTS;
476 ------------
477 -- Wakeup --
478 ------------
480 procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
481 begin
482 null;
483 end Wakeup;
485 ----------------
486 -- Write_Lock --
487 ----------------
489 procedure Write_Lock
490 (L : not null access Lock;
491 Ceiling_Violation : out Boolean)
493 begin
494 Ceiling_Violation := False;
495 end Write_Lock;
497 procedure Write_Lock
498 (L : not null access RTS_Lock;
499 Global_Lock : Boolean := False)
501 begin
502 null;
503 end Write_Lock;
505 procedure Write_Lock (T : Task_Id) is
506 begin
507 null;
508 end Write_Lock;
510 -----------
511 -- Yield --
512 -----------
514 procedure Yield (Do_Yield : Boolean := True) is
515 begin
516 null;
517 end Yield;
519 end System.Task_Primitives.Operations;