OSDN Git Service

2007-08-14 Robert Dewar <dewar@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / 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-2007, 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 2,  or (at your option) any later ver- --
14 -- sion. GNARL 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.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20 -- Boston, MA 02110-1301, USA.                                              --
21 --                                                                          --
22 -- As a special exception,  if other files  instantiate  generics from this --
23 -- unit, or you link  this unit with other files  to produce an executable, --
24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
25 -- covered  by the  GNU  General  Public  License.  This exception does not --
26 -- however invalidate  any other reasons why  the executable file  might be --
27 -- covered by the  GNU Public License.                                      --
28 --                                                                          --
29 -- GNARL was developed by the GNARL team at Florida State University.       --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
31 --                                                                          --
32 ------------------------------------------------------------------------------
33
34 --  This is a no tasking version of this package
35
36 --  This package contains all the GNULL primitives that interface directly
37 --  with the underlying OS.
38
39 pragma Polling (Off);
40 --  Turn off polling, we do not want ATC polling to take place during
41 --  tasking operations. It causes infinite loops and other problems.
42
43 with System.Error_Reporting;
44 --  used for Shutdown
45
46 package body System.Task_Primitives.Operations is
47
48    use System.Tasking;
49    use System.Parameters;
50
51    pragma Warnings (Off);
52    --  Turn off warnings since so many unreferenced parameters
53
54    ----------------
55    -- Abort_Task --
56    ----------------
57
58    procedure Abort_Task (T : Task_Id) is
59    begin
60       null;
61    end Abort_Task;
62
63    ----------------
64    -- Check_Exit --
65    ----------------
66
67    function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
68    begin
69       return True;
70    end Check_Exit;
71
72    --------------------
73    -- Check_No_Locks --
74    --------------------
75
76    function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
77    begin
78       return True;
79    end Check_No_Locks;
80
81    -------------------
82    -- Continue_Task --
83    -------------------
84
85    function Continue_Task (T : ST.Task_Id) return Boolean is
86    begin
87       return False;
88    end Continue_Task;
89
90    -------------------
91    -- Current_State --
92    -------------------
93
94    function Current_State (S : Suspension_Object) return Boolean is
95    begin
96       return False;
97    end Current_State;
98
99    ----------------------
100    -- Environment_Task --
101    ----------------------
102
103    function Environment_Task return Task_Id is
104    begin
105       return null;
106    end Environment_Task;
107
108    -----------------
109    -- Create_Task --
110    -----------------
111
112    procedure Create_Task
113      (T          : Task_Id;
114       Wrapper    : System.Address;
115       Stack_Size : System.Parameters.Size_Type;
116       Priority   : System.Any_Priority;
117       Succeeded  : out Boolean)
118    is
119    begin
120       Succeeded := False;
121    end Create_Task;
122
123    ----------------
124    -- Enter_Task --
125    ----------------
126
127    procedure Enter_Task (Self_ID : Task_Id) is
128    begin
129       null;
130    end Enter_Task;
131
132    ---------------
133    -- Exit_Task --
134    ---------------
135
136    procedure Exit_Task is
137    begin
138       null;
139    end Exit_Task;
140
141    --------------
142    -- Finalize --
143    --------------
144
145    procedure Finalize (S : in out Suspension_Object) is
146    begin
147       null;
148    end Finalize;
149
150    -------------------
151    -- Finalize_Lock --
152    -------------------
153
154    procedure Finalize_Lock (L : not null access Lock) is
155    begin
156       null;
157    end Finalize_Lock;
158
159    procedure Finalize_Lock (L : not null access RTS_Lock) is
160    begin
161       null;
162    end Finalize_Lock;
163
164    ------------------
165    -- Finalize_TCB --
166    ------------------
167
168    procedure Finalize_TCB (T : Task_Id) is
169    begin
170       null;
171    end Finalize_TCB;
172
173    ------------------
174    -- Get_Priority --
175    ------------------
176
177    function Get_Priority (T : Task_Id) return System.Any_Priority is
178    begin
179       return 0;
180    end Get_Priority;
181
182    --------------------
183    -- Get_Thread_Id  --
184    --------------------
185
186    function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
187    begin
188       return OSI.Thread_Id (T.Common.LL.Thread);
189    end Get_Thread_Id;
190
191    ----------------
192    -- Initialize --
193    ----------------
194
195    procedure Initialize (Environment_Task : Task_Id) is
196       No_Tasking : Boolean;
197    begin
198       No_Tasking :=
199         System.Error_Reporting.Shutdown
200           ("Tasking not implemented on this configuration");
201    end Initialize;
202
203    procedure Initialize (S : in out Suspension_Object) is
204    begin
205       null;
206    end Initialize;
207
208    ---------------------
209    -- Initialize_Lock --
210    ---------------------
211
212    procedure Initialize_Lock
213      (Prio : System.Any_Priority;
214       L    : not null access Lock)
215    is
216    begin
217       null;
218    end Initialize_Lock;
219
220    procedure Initialize_Lock
221      (L : not null access RTS_Lock; Level : Lock_Level) is
222    begin
223       null;
224    end Initialize_Lock;
225
226    --------------------
227    -- Initialize_TCB --
228    --------------------
229
230    procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
231    begin
232       Succeeded := False;
233    end Initialize_TCB;
234
235    -------------------
236    -- Is_Valid_Task --
237    -------------------
238
239    function Is_Valid_Task return Boolean is
240    begin
241       return False;
242    end Is_Valid_Task;
243
244    --------------
245    -- Lock_RTS --
246    --------------
247
248    procedure Lock_RTS is
249    begin
250       null;
251    end Lock_RTS;
252
253    ---------------------
254    -- Monotonic_Clock --
255    ---------------------
256
257    function Monotonic_Clock return Duration is
258    begin
259       return 0.0;
260    end Monotonic_Clock;
261
262    --------------
263    -- New_ATCB --
264    --------------
265
266    function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
267    begin
268       return new Ada_Task_Control_Block (Entry_Num);
269    end New_ATCB;
270
271    ---------------
272    -- Read_Lock --
273    ---------------
274
275    procedure Read_Lock
276      (L                 : not null access Lock;
277       Ceiling_Violation : out Boolean)
278    is
279    begin
280       Ceiling_Violation := False;
281    end Read_Lock;
282
283    -----------------------------
284    -- Register_Foreign_Thread --
285    -----------------------------
286
287    function Register_Foreign_Thread return Task_Id is
288    begin
289       return null;
290    end Register_Foreign_Thread;
291
292    -----------------
293    -- Resume_Task --
294    -----------------
295
296    function Resume_Task
297      (T           : ST.Task_Id;
298       Thread_Self : OSI.Thread_Id) return Boolean
299    is
300    begin
301       return False;
302    end Resume_Task;
303
304    -------------------
305    -- RT_Resolution --
306    -------------------
307
308    function RT_Resolution return Duration is
309    begin
310       return 10#1.0#E-6;
311    end RT_Resolution;
312
313    ----------
314    -- Self --
315    ----------
316
317    function Self return Task_Id is
318    begin
319       return Null_Task;
320    end Self;
321
322    -----------------
323    -- Set_Ceiling --
324    -----------------
325
326    procedure Set_Ceiling
327      (L    : not null access Lock;
328       Prio : System.Any_Priority)
329    is
330    begin
331       null;
332    end Set_Ceiling;
333
334    ---------------
335    -- Set_False --
336    ---------------
337
338    procedure Set_False (S : in out Suspension_Object) is
339    begin
340       null;
341    end Set_False;
342
343    ------------------
344    -- Set_Priority --
345    ------------------
346
347    procedure Set_Priority
348      (T                   : Task_Id;
349       Prio                : System.Any_Priority;
350       Loss_Of_Inheritance : Boolean := False)
351    is
352    begin
353       null;
354    end Set_Priority;
355
356    --------------
357    -- Set_True --
358    --------------
359
360    procedure Set_True (S : in out Suspension_Object) is
361    begin
362       null;
363    end Set_True;
364
365    -----------
366    -- Sleep --
367    -----------
368
369    procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
370    begin
371       null;
372    end Sleep;
373
374    -----------------
375    -- Stack_Guard --
376    -----------------
377
378    procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
379    begin
380       null;
381    end Stack_Guard;
382
383    ------------------
384    -- Suspend_Task --
385    ------------------
386
387    function Suspend_Task
388      (T           : ST.Task_Id;
389       Thread_Self : OSI.Thread_Id) return Boolean
390    is
391    begin
392       return False;
393    end Suspend_Task;
394
395    --------------------
396    -- Stop_All_Tasks --
397    --------------------
398
399    procedure Stop_All_Tasks is
400    begin
401       null;
402    end Stop_All_Tasks;
403
404    ------------------------
405    -- Suspend_Until_True --
406    ------------------------
407
408    procedure Suspend_Until_True (S : in out Suspension_Object) is
409    begin
410       null;
411    end Suspend_Until_True;
412
413    -----------------
414    -- Timed_Delay --
415    -----------------
416
417    procedure Timed_Delay
418      (Self_ID : Task_Id;
419       Time    : Duration;
420       Mode    : ST.Delay_Modes)
421    is
422    begin
423       null;
424    end Timed_Delay;
425
426    -----------------
427    -- Timed_Sleep --
428    -----------------
429
430    procedure Timed_Sleep
431      (Self_ID  : Task_Id;
432       Time     : Duration;
433       Mode     : ST.Delay_Modes;
434       Reason   : System.Tasking.Task_States;
435       Timedout : out Boolean;
436       Yielded  : out Boolean)
437    is
438    begin
439       Timedout := False;
440       Yielded := False;
441    end Timed_Sleep;
442
443    ------------
444    -- Unlock --
445    ------------
446
447    procedure Unlock (L : not null access Lock) is
448    begin
449       null;
450    end Unlock;
451
452    procedure Unlock
453      (L           : not null access RTS_Lock;
454       Global_Lock : Boolean := False)
455    is
456    begin
457       null;
458    end Unlock;
459
460    procedure Unlock (T : Task_Id) is
461    begin
462       null;
463    end Unlock;
464
465    ----------------
466    -- Unlock_RTS --
467    ----------------
468
469    procedure Unlock_RTS is
470    begin
471       null;
472    end Unlock_RTS;
473    ------------
474    -- Wakeup --
475    ------------
476
477    procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
478    begin
479       null;
480    end Wakeup;
481
482    ----------------
483    -- Write_Lock --
484    ----------------
485
486    procedure Write_Lock
487      (L                 : not null access Lock;
488       Ceiling_Violation : out Boolean)
489    is
490    begin
491       Ceiling_Violation := False;
492    end Write_Lock;
493
494    procedure Write_Lock
495      (L           : not null access RTS_Lock;
496       Global_Lock : Boolean := False)
497    is
498    begin
499       null;
500    end Write_Lock;
501
502    procedure Write_Lock (T : Task_Id) is
503    begin
504       null;
505    end Write_Lock;
506
507    -----------
508    -- Yield --
509    -----------
510
511    procedure Yield (Do_Yield : Boolean := True) is
512    begin
513       null;
514    end Yield;
515
516 end System.Task_Primitives.Operations;