1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
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 --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 -- This is a no tasking version of this package
34 -- This package contains all the GNULL primitives that interface directly with
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
44 use System.Parameters;
46 pragma Warnings (Off);
47 -- Turn off warnings since so many unreferenced parameters
49 ----------------------------------
50 -- ATCB allocation/deallocation --
51 ----------------------------------
53 package body ATCB_Allocation is separate;
54 -- The body of this package is shared across several targets
60 procedure Abort_Task (T : Task_Id) is
69 function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
78 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
87 function Continue_Task (T : ST.Task_Id) return Boolean is
96 function Current_State (S : Suspension_Object) return Boolean is
101 ----------------------
102 -- Environment_Task --
103 ----------------------
105 function Environment_Task return Task_Id is
108 end Environment_Task;
114 procedure Create_Task
116 Wrapper : System.Address;
117 Stack_Size : System.Parameters.Size_Type;
118 Priority : System.Any_Priority;
119 Succeeded : out Boolean)
129 procedure Enter_Task (Self_ID : Task_Id) is
138 procedure Exit_Task is
147 procedure Finalize (S : in out Suspension_Object) is
156 procedure Finalize_Lock (L : not null access Lock) is
161 procedure Finalize_Lock (L : not null access RTS_Lock) is
170 procedure Finalize_TCB (T : Task_Id) is
179 function Get_Priority (T : Task_Id) return System.Any_Priority is
188 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
190 return OSI.Thread_Id (T.Common.LL.Thread);
197 procedure Initialize (Environment_Task : Task_Id) is
198 No_Tasking : Boolean;
200 raise Program_Error with "tasking not implemented on this configuration";
203 procedure Initialize (S : in out Suspension_Object) is
208 ---------------------
209 -- Initialize_Lock --
210 ---------------------
212 procedure Initialize_Lock
213 (Prio : System.Any_Priority;
214 L : not null access Lock)
220 procedure Initialize_Lock
221 (L : not null access RTS_Lock; Level : Lock_Level) is
230 procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
239 function Is_Valid_Task return Boolean is
248 procedure Lock_RTS is
253 ---------------------
254 -- Monotonic_Clock --
255 ---------------------
257 function Monotonic_Clock return Duration is
267 (L : not null access Lock;
268 Ceiling_Violation : out Boolean)
271 Ceiling_Violation := False;
274 -----------------------------
275 -- Register_Foreign_Thread --
276 -----------------------------
278 function Register_Foreign_Thread return Task_Id is
281 end Register_Foreign_Thread;
289 Thread_Self : OSI.Thread_Id) return Boolean
299 function RT_Resolution return Duration is
308 function Self return Task_Id is
317 procedure Set_Ceiling
318 (L : not null access Lock;
319 Prio : System.Any_Priority)
329 procedure Set_False (S : in out Suspension_Object) is
338 procedure Set_Priority
340 Prio : System.Any_Priority;
341 Loss_Of_Inheritance : Boolean := False)
347 -----------------------
348 -- Set_Task_Affinity --
349 -----------------------
351 procedure Set_Task_Affinity (T : ST.Task_Id) is
354 end Set_Task_Affinity;
360 procedure Set_True (S : in out Suspension_Object) is
369 procedure Sleep (Self_ID : Task_Id; Reason : System.Tasking.Task_States) is
378 procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
387 function Suspend_Task
389 Thread_Self : OSI.Thread_Id) return Boolean
399 procedure Stop_All_Tasks is
408 function Stop_Task (T : ST.Task_Id) return Boolean is
409 pragma Unreferenced (T);
414 ------------------------
415 -- Suspend_Until_True --
416 ------------------------
418 procedure Suspend_Until_True (S : in out Suspension_Object) is
421 end Suspend_Until_True;
427 procedure Timed_Delay
430 Mode : ST.Delay_Modes)
440 procedure Timed_Sleep
443 Mode : ST.Delay_Modes;
444 Reason : System.Tasking.Task_States;
445 Timedout : out Boolean;
446 Yielded : out Boolean)
457 procedure Unlock (L : not null access Lock) is
463 (L : not null access RTS_Lock;
464 Global_Lock : Boolean := False)
470 procedure Unlock (T : Task_Id) is
479 procedure Unlock_RTS is
487 procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
497 (L : not null access Lock;
498 Ceiling_Violation : out Boolean)
501 Ceiling_Violation := False;
505 (L : not null access RTS_Lock;
506 Global_Lock : Boolean := False)
512 procedure Write_Lock (T : Task_Id) is
521 procedure Yield (Do_Yield : Boolean := True) is
526 end System.Task_Primitives.Operations;