1 ------------------------------------------------------------------------------
3 -- GNU ADA 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-2003, 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 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
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. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 -- This is a IRIX (pthread library) version of this package.
36 -- This package contains all the GNULL primitives that interface directly
37 -- with the underlying OS.
40 -- Turn off polling, we do not want ATC polling to take place during
41 -- tasking operations. It causes infinite loops and other problems.
47 with System.Task_Info;
49 with System.Tasking.Debug;
50 -- used for Known_Tasks
55 with System.Interrupt_Management;
56 -- used for Keep_Unmasked
57 -- Abort_Task_Interrupt
60 with System.Interrupt_Management.Operations;
61 -- used for Set_Interrupt_Mask
63 pragma Elaborate_All (System.Interrupt_Management.Operations);
65 with System.Parameters;
69 -- used for Ada_Task_Control_Block
72 with System.Soft_Links;
73 -- used for Defer/Undefer_Abort
75 -- Note that we do not use System.Tasking.Initialization directly since
76 -- this is a higher level package that we shouldn't depend on. For example
77 -- when using the restricted run time, it is replaced by
78 -- System.Tasking.Restricted.Initialization
80 with System.Program_Info;
81 -- used for Default_Task_Stack
84 -- Pthread_Sched_Signal
87 with System.OS_Interface;
88 -- used for various type, constant, and operations
90 with System.OS_Primitives;
91 -- used for Delay_Modes
93 with Unchecked_Conversion;
94 with Unchecked_Deallocation;
96 package body System.Task_Primitives.Operations is
99 use System.Tasking.Debug;
101 use System.OS_Interface;
102 use System.OS_Primitives;
103 use System.Parameters;
105 package SSL renames System.Soft_Links;
111 -- The followings are logically constants, but need to be initialized
114 Single_RTS_Lock : aliased RTS_Lock;
115 -- This is a lock to allow only one thread of control in the RTS at
116 -- a time; it is used to execute in mutual exclusion from all other tasks.
117 -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
119 ATCB_Key : aliased pthread_key_t;
120 -- Key used to find the Ada Task_ID associated with a thread
122 Environment_Task_ID : Task_ID;
123 -- A variable to hold Task_ID for the environment task.
125 Locking_Policy : Character;
126 pragma Import (C, Locking_Policy, "__gl_locking_policy");
128 Real_Time_Clock_Id : constant clockid_t := CLOCK_REALTIME;
130 Unblocked_Signal_Mask : aliased sigset_t;
132 Foreign_Task_Elaborated : aliased Boolean := True;
133 -- Used to identified fake tasks (i.e., non-Ada Threads).
141 procedure Initialize (Environment_Task : Task_ID);
142 pragma Inline (Initialize);
143 -- Initialize various data needed by this package.
145 function Is_Valid_Task return Boolean;
146 pragma Inline (Is_Valid_Task);
147 -- Does executing thread have a TCB?
149 procedure Set (Self_Id : Task_ID);
151 -- Set the self id for the current task.
153 function Self return Task_ID;
154 pragma Inline (Self);
155 -- Return a pointer to the Ada Task Control Block of the calling task.
159 package body Specific is separate;
160 -- The body of this package is target specific.
162 ---------------------------------
163 -- Support for foreign threads --
164 ---------------------------------
166 function Register_Foreign_Thread (Thread : Thread_Id) return Task_ID;
167 -- Allocate and Initialize a new ATCB for the current Thread.
169 function Register_Foreign_Thread
170 (Thread : Thread_Id) return Task_ID is separate;
172 -----------------------
173 -- Local Subprograms --
174 -----------------------
176 function To_Address is new Unchecked_Conversion (Task_ID, System.Address);
178 procedure Abort_Handler (Sig : Signal);
179 -- Signal handler used to implement asynchronous abort.
185 procedure Abort_Handler (Sig : Signal) is
186 pragma Unreferenced (Sig);
188 T : constant Task_ID := Self;
189 Result : Interfaces.C.int;
190 Old_Set : aliased sigset_t;
193 -- It is not safe to raise an exception when using ZCX and the GCC
194 -- exception handling mechanism.
196 if ZCX_By_Default and then GCC_ZCX_Support then
200 if T.Deferral_Level = 0
201 and then T.Pending_ATC_Level < T.ATC_Nesting_Level
203 -- Make sure signals used for RTS internal purpose are unmasked
205 Result := pthread_sigmask
207 Unblocked_Signal_Mask'Unchecked_Access,
208 Old_Set'Unchecked_Access);
209 pragma Assert (Result = 0);
211 raise Standard'Abort_Signal;
219 -- The underlying thread system sets a guard page at the
220 -- bottom of a thread stack, so nothing is needed.
222 procedure Stack_Guard (T : ST.Task_ID; On : Boolean) is
223 pragma Unreferenced (On);
224 pragma Unreferenced (T);
234 function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id is
236 return T.Common.LL.Thread;
243 function Self return Task_ID renames Specific.Self;
245 ---------------------
246 -- Initialize_Lock --
247 ---------------------
249 -- Note: mutexes and cond_variables needed per-task basis are
250 -- initialized in Initialize_TCB and the Storage_Error is
251 -- handled. Other mutexes (such as RTS_Lock, Memory_Lock...)
252 -- used in RTS is initialized before any status change of RTS.
253 -- Therefore rasing Storage_Error in the following routines
254 -- should be able to be handled safely.
256 procedure Initialize_Lock
257 (Prio : System.Any_Priority;
260 Attributes : aliased pthread_mutexattr_t;
261 Result : Interfaces.C.int;
264 Result := pthread_mutexattr_init (Attributes'Access);
265 pragma Assert (Result = 0 or else Result = ENOMEM);
267 if Result = ENOMEM then
271 if Locking_Policy = 'C' then
272 Result := pthread_mutexattr_setprotocol
273 (Attributes'Access, PTHREAD_PRIO_PROTECT);
274 pragma Assert (Result = 0);
276 Result := pthread_mutexattr_setprioceiling
277 (Attributes'Access, Interfaces.C.int (Prio));
278 pragma Assert (Result = 0);
281 Result := pthread_mutex_init (L, Attributes'Access);
282 pragma Assert (Result = 0 or else Result = ENOMEM);
284 if Result = ENOMEM then
285 Result := pthread_mutexattr_destroy (Attributes'Access);
289 Result := pthread_mutexattr_destroy (Attributes'Access);
290 pragma Assert (Result = 0);
293 procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
294 pragma Unreferenced (Level);
296 Attributes : aliased pthread_mutexattr_t;
297 Result : Interfaces.C.int;
300 Result := pthread_mutexattr_init (Attributes'Access);
301 pragma Assert (Result = 0 or else Result = ENOMEM);
303 if Result = ENOMEM then
307 if Locking_Policy = 'C' then
308 Result := pthread_mutexattr_setprotocol
309 (Attributes'Access, PTHREAD_PRIO_PROTECT);
310 pragma Assert (Result = 0);
312 Result := pthread_mutexattr_setprioceiling
313 (Attributes'Access, Interfaces.C.int (System.Any_Priority'Last));
314 pragma Assert (Result = 0);
317 Result := pthread_mutex_init (L, Attributes'Access);
319 pragma Assert (Result = 0 or else Result = ENOMEM);
321 if Result = ENOMEM then
322 Result := pthread_mutexattr_destroy (Attributes'Access);
326 Result := pthread_mutexattr_destroy (Attributes'Access);
333 procedure Finalize_Lock (L : access Lock) is
334 Result : Interfaces.C.int;
337 Result := pthread_mutex_destroy (L);
338 pragma Assert (Result = 0);
341 procedure Finalize_Lock (L : access RTS_Lock) is
342 Result : Interfaces.C.int;
345 Result := pthread_mutex_destroy (L);
346 pragma Assert (Result = 0);
353 procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
354 Result : Interfaces.C.int;
356 Result := pthread_mutex_lock (L);
357 Ceiling_Violation := Result = EINVAL;
359 -- assumes the cause of EINVAL is a priority ceiling violation
361 pragma Assert (Result = 0 or else Result = EINVAL);
365 (L : access RTS_Lock; Global_Lock : Boolean := False)
367 Result : Interfaces.C.int;
369 if not Single_Lock or else Global_Lock then
370 Result := pthread_mutex_lock (L);
371 pragma Assert (Result = 0);
375 procedure Write_Lock (T : Task_ID) is
376 Result : Interfaces.C.int;
378 if not Single_Lock then
379 Result := pthread_mutex_lock (T.Common.LL.L'Access);
380 pragma Assert (Result = 0);
388 procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
390 Write_Lock (L, Ceiling_Violation);
397 procedure Unlock (L : access Lock) is
398 Result : Interfaces.C.int;
401 Result := pthread_mutex_unlock (L);
402 pragma Assert (Result = 0);
405 procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
406 Result : Interfaces.C.int;
409 if not Single_Lock or else Global_Lock then
410 Result := pthread_mutex_unlock (L);
411 pragma Assert (Result = 0);
415 procedure Unlock (T : Task_ID) is
416 Result : Interfaces.C.int;
419 if not Single_Lock then
420 Result := pthread_mutex_unlock (T.Common.LL.L'Access);
421 pragma Assert (Result = 0);
430 (Self_ID : ST.Task_ID;
431 Reason : System.Tasking.Task_States)
433 pragma Unreferenced (Reason);
435 Result : Interfaces.C.int;
439 Result := pthread_cond_wait
440 (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
442 Result := pthread_cond_wait
443 (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
446 -- EINTR is not considered a failure.
448 pragma Assert (Result = 0 or else Result = EINTR);
455 procedure Timed_Sleep
458 Mode : ST.Delay_Modes;
459 Reason : Task_States;
460 Timedout : out Boolean;
461 Yielded : out Boolean)
463 pragma Unreferenced (Reason);
465 Check_Time : constant Duration := Monotonic_Clock;
467 Request : aliased timespec;
468 Result : Interfaces.C.int;
474 if Mode = Relative then
475 Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
477 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
480 if Abs_Time > Check_Time then
481 Request := To_Timespec (Abs_Time);
484 exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
485 or else Self_ID.Pending_Priority_Change;
488 Result := pthread_cond_timedwait
489 (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access,
493 Result := pthread_cond_timedwait
494 (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access,
498 exit when Abs_Time <= Monotonic_Clock;
500 if Result = 0 or else errno = EINTR then
512 -- This is for use in implementing delay statements, so
513 -- we assume the caller is abort-deferred but is holding
516 procedure Timed_Delay
519 Mode : ST.Delay_Modes)
521 Check_Time : constant Duration := Monotonic_Clock;
523 Request : aliased timespec;
524 Result : Interfaces.C.int;
527 -- Only the little window between deferring abort and
528 -- locking Self_ID is the reason we need to
529 -- check for pending abort and priority change below! :(
537 Write_Lock (Self_ID);
539 if Mode = Relative then
540 Abs_Time := Time + Check_Time;
542 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
545 if Abs_Time > Check_Time then
546 Request := To_Timespec (Abs_Time);
547 Self_ID.Common.State := Delay_Sleep;
550 if Self_ID.Pending_Priority_Change then
551 Self_ID.Pending_Priority_Change := False;
552 Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
553 Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
556 exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
558 Result := pthread_cond_timedwait (Self_ID.Common.LL.CV'Access,
559 Self_ID.Common.LL.L'Access, Request'Access);
560 exit when Abs_Time <= Monotonic_Clock;
562 pragma Assert (Result = 0
563 or else Result = ETIMEDOUT
564 or else Result = EINTR);
567 Self_ID.Common.State := Runnable;
577 SSL.Abort_Undefer.all;
580 ---------------------
581 -- Monotonic_Clock --
582 ---------------------
584 function Monotonic_Clock return Duration is
585 TS : aliased timespec;
586 Result : Interfaces.C.int;
589 Result := clock_gettime (Real_Time_Clock_Id, TS'Unchecked_Access);
590 pragma Assert (Result = 0);
591 return To_Duration (TS);
598 function RT_Resolution return Duration is
600 -- The clock_getres (Real_Time_Clock_Id) function appears to return
601 -- the interrupt resolution of the realtime clock and not the actual
602 -- resolution of reading the clock. Even though this last value is
603 -- only guaranteed to be 100 Hz, at least the Origin 200 appears to
604 -- have a microsecond resolution or better.
605 -- ??? We should figure out a method to return the right value on
608 return 0.000_001; -- Assume microsecond resolution of clock
615 procedure Wakeup (T : ST.Task_ID; Reason : System.Tasking.Task_States) is
616 pragma Unreferenced (Reason);
618 Result : Interfaces.C.int;
621 Result := pthread_cond_signal (T.Common.LL.CV'Access);
622 pragma Assert (Result = 0);
629 procedure Yield (Do_Yield : Boolean := True) is
630 Result : Interfaces.C.int;
634 Result := sched_yield;
642 procedure Set_Priority
644 Prio : System.Any_Priority;
645 Loss_Of_Inheritance : Boolean := False)
647 pragma Unreferenced (Loss_Of_Inheritance);
649 Result : Interfaces.C.int;
650 Param : aliased struct_sched_param;
651 Sched_Policy : Interfaces.C.int;
653 use type System.Task_Info.Task_Info_Type;
655 function To_Int is new Unchecked_Conversion
656 (System.Task_Info.Thread_Scheduling_Policy, Interfaces.C.int);
659 T.Common.Current_Priority := Prio;
660 Param.sched_priority := Interfaces.C.int (Prio);
662 if T.Common.Task_Info /= null then
663 Sched_Policy := To_Int (T.Common.Task_Info.Policy);
665 Sched_Policy := SCHED_FIFO;
668 Result := pthread_setschedparam (T.Common.LL.Thread, Sched_Policy,
670 pragma Assert (Result = 0);
677 function Get_Priority (T : Task_ID) return System.Any_Priority is
679 return T.Common.Current_Priority;
686 procedure Enter_Task (Self_ID : Task_ID) is
687 Result : Interfaces.C.int;
689 function To_Int is new Unchecked_Conversion
690 (System.Task_Info.CPU_Number, Interfaces.C.int);
692 use System.Task_Info;
695 Self_ID.Common.LL.Thread := pthread_self;
696 Specific.Set (Self_ID);
698 if Self_ID.Common.Task_Info /= null
699 and then Self_ID.Common.Task_Info.Scope = PTHREAD_SCOPE_SYSTEM
700 and then Self_ID.Common.Task_Info.Runon_CPU /= ANY_CPU
702 Result := pthread_setrunon_np
703 (To_Int (Self_ID.Common.Task_Info.Runon_CPU));
704 pragma Assert (Result = 0);
709 for J in Known_Tasks'Range loop
710 if Known_Tasks (J) = null then
711 Known_Tasks (J) := Self_ID;
712 Self_ID.Known_Tasks_Index := J;
724 function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is
726 return new Ada_Task_Control_Block (Entry_Num);
733 function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task;
735 -----------------------------
736 -- Register_Foreign_Thread --
737 -----------------------------
739 function Register_Foreign_Thread return Task_ID is
741 if Is_Valid_Task then
744 return Register_Foreign_Thread (pthread_self);
746 end Register_Foreign_Thread;
752 procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is
753 Result : Interfaces.C.int;
754 Cond_Attr : aliased pthread_condattr_t;
757 if not Single_Lock then
758 Initialize_Lock (Self_ID.Common.LL.L'Access, ATCB_Level);
761 Result := pthread_condattr_init (Cond_Attr'Access);
762 pragma Assert (Result = 0 or else Result = ENOMEM);
765 Result := pthread_cond_init (Self_ID.Common.LL.CV'Access,
767 pragma Assert (Result = 0 or else Result = ENOMEM);
773 if not Single_Lock then
774 Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
775 pragma Assert (Result = 0);
781 Result := pthread_condattr_destroy (Cond_Attr'Access);
782 pragma Assert (Result = 0);
789 procedure Create_Task
791 Wrapper : System.Address;
792 Stack_Size : System.Parameters.Size_Type;
793 Priority : System.Any_Priority;
794 Succeeded : out Boolean)
796 use System.Task_Info;
798 Attributes : aliased pthread_attr_t;
799 Sched_Param : aliased struct_sched_param;
800 Adjusted_Stack_Size : Interfaces.C.size_t;
801 Result : Interfaces.C.int;
803 function Thread_Body_Access is new
804 Unchecked_Conversion (System.Address, Thread_Body);
806 function To_Int is new Unchecked_Conversion
807 (System.Task_Info.Thread_Scheduling_Scope, Interfaces.C.int);
808 function To_Int is new Unchecked_Conversion
809 (System.Task_Info.Thread_Scheduling_Inheritance, Interfaces.C.int);
810 function To_Int is new Unchecked_Conversion
811 (System.Task_Info.Thread_Scheduling_Policy, Interfaces.C.int);
814 if Stack_Size = System.Parameters.Unspecified_Size then
815 Adjusted_Stack_Size :=
816 Interfaces.C.size_t (System.Program_Info.Default_Task_Stack);
818 elsif Stack_Size < Size_Type (Minimum_Stack_Size) then
819 Adjusted_Stack_Size :=
820 Interfaces.C.size_t (Minimum_Stack_Size);
823 Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
826 Result := pthread_attr_init (Attributes'Access);
827 pragma Assert (Result = 0 or else Result = ENOMEM);
834 Result := pthread_attr_setdetachstate
835 (Attributes'Access, PTHREAD_CREATE_DETACHED);
836 pragma Assert (Result = 0);
838 Result := pthread_attr_setstacksize
839 (Attributes'Access, Adjusted_Stack_Size);
840 pragma Assert (Result = 0);
842 if T.Common.Task_Info /= null then
843 Result := pthread_attr_setscope
844 (Attributes'Access, To_Int (T.Common.Task_Info.Scope));
845 pragma Assert (Result = 0);
847 Result := pthread_attr_setinheritsched
848 (Attributes'Access, To_Int (T.Common.Task_Info.Inheritance));
849 pragma Assert (Result = 0);
851 Result := pthread_attr_setschedpolicy
852 (Attributes'Access, To_Int (T.Common.Task_Info.Policy));
853 pragma Assert (Result = 0);
855 Sched_Param.sched_priority :=
856 Interfaces.C.int (T.Common.Task_Info.Priority);
858 Result := pthread_attr_setschedparam
859 (Attributes'Access, Sched_Param'Access);
860 pragma Assert (Result = 0);
863 -- Since the initial signal mask of a thread is inherited from the
864 -- creator, and the Environment task has all its signals masked, we
865 -- do not need to manipulate caller's signal mask at this point.
866 -- All tasks in RTS will have All_Tasks_Mask initially.
868 Result := pthread_create
869 (T.Common.LL.Thread'Access,
871 Thread_Body_Access (Wrapper),
875 and then T.Common.Task_Info /= null
876 and then T.Common.Task_Info.Scope = PTHREAD_SCOPE_SYSTEM
878 -- The pthread_create call may have failed because we
879 -- asked for a system scope pthread and none were
880 -- available (probably because the program was not executed
881 -- by the superuser). Let's try for a process scope pthread
882 -- instead of raising Tasking_Error.
885 ("Request for PTHREAD_SCOPE_SYSTEM in Task_Info pragma for task");
886 System.IO.Put ("""");
887 System.IO.Put (T.Common.Task_Image (1 .. T.Common.Task_Image_Len));
888 System.IO.Put_Line (""" could not be honored. ");
889 System.IO.Put_Line ("Scope changed to PTHREAD_SCOPE_PROCESS");
891 T.Common.Task_Info.Scope := PTHREAD_SCOPE_PROCESS;
892 Result := pthread_attr_setscope
893 (Attributes'Access, To_Int (T.Common.Task_Info.Scope));
894 pragma Assert (Result = 0);
896 Result := pthread_create
897 (T.Common.LL.Thread'Access,
899 Thread_Body_Access (Wrapper),
903 pragma Assert (Result = 0 or else Result = EAGAIN);
905 Succeeded := Result = 0;
907 -- The following needs significant commenting ???
909 if T.Common.Task_Info /= null then
910 T.Common.Base_Priority := T.Common.Task_Info.Priority;
911 Set_Priority (T, T.Common.Task_Info.Priority);
913 Set_Priority (T, Priority);
916 Result := pthread_attr_destroy (Attributes'Access);
917 pragma Assert (Result = 0);
924 procedure Finalize_TCB (T : Task_ID) is
925 Result : Interfaces.C.int;
927 Is_Self : constant Boolean := T = Self;
929 procedure Free is new
930 Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID);
933 if not Single_Lock then
934 Result := pthread_mutex_destroy (T.Common.LL.L'Access);
935 pragma Assert (Result = 0);
938 Result := pthread_cond_destroy (T.Common.LL.CV'Access);
939 pragma Assert (Result = 0);
941 if T.Known_Tasks_Index /= -1 then
942 Known_Tasks (T.Known_Tasks_Index) := null;
948 Result := pthread_setspecific (ATCB_Key, System.Null_Address);
949 pragma Assert (Result = 0);
958 procedure Exit_Task is
967 procedure Abort_Task (T : Task_ID) is
968 Result : Interfaces.C.int;
971 Result := pthread_kill (T.Common.LL.Thread,
972 Signal (System.Interrupt_Management.Abort_Task_Interrupt));
973 pragma Assert (Result = 0);
982 function Check_Exit (Self_ID : ST.Task_ID) return Boolean is
983 pragma Unreferenced (Self_ID);
993 function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is
994 pragma Unreferenced (Self_ID);
1000 ----------------------
1001 -- Environment_Task --
1002 ----------------------
1004 function Environment_Task return Task_ID is
1006 return Environment_Task_ID;
1007 end Environment_Task;
1013 procedure Lock_RTS is
1015 Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
1022 procedure Unlock_RTS is
1024 Unlock (Single_RTS_Lock'Access, Global_Lock => True);
1031 function Suspend_Task
1033 Thread_Self : Thread_Id)
1036 pragma Unreferenced (T);
1037 pragma Unreferenced (Thread_Self);
1047 function Resume_Task
1049 Thread_Self : Thread_Id)
1052 pragma Unreferenced (T);
1053 pragma Unreferenced (Thread_Self);
1063 procedure Initialize (Environment_Task : Task_ID) is
1064 act : aliased struct_sigaction;
1065 old_act : aliased struct_sigaction;
1066 Tmp_Set : aliased sigset_t;
1067 Result : Interfaces.C.int;
1069 function State (Int : System.Interrupt_Management.Interrupt_ID)
1071 pragma Import (C, State, "__gnat_get_interrupt_state");
1072 -- Get interrupt state. Defined in a-init.c
1073 -- The input argument is the interrupt number,
1074 -- and the result is one of the following:
1076 Default : constant Character := 's';
1077 -- 'n' this interrupt not set by any Interrupt_State pragma
1078 -- 'u' Interrupt_State pragma set state to User
1079 -- 'r' Interrupt_State pragma set state to Runtime
1080 -- 's' Interrupt_State pragma set state to System (use "default"
1084 Environment_Task_ID := Environment_Task;
1086 -- Initialize the lock used to synchronize chain of all ATCBs.
1088 Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
1090 Specific.Initialize (Environment_Task);
1092 Enter_Task (Environment_Task);
1094 -- Install the abort-signal handler
1096 if State (System.Interrupt_Management.Abort_Task_Interrupt)
1100 act.sa_handler := Abort_Handler'Address;
1102 Result := sigemptyset (Tmp_Set'Access);
1103 pragma Assert (Result = 0);
1104 act.sa_mask := Tmp_Set;
1108 Signal (System.Interrupt_Management.Abort_Task_Interrupt),
1109 act'Unchecked_Access,
1110 old_act'Unchecked_Access);
1111 pragma Assert (Result = 0);
1117 Result : Interfaces.C.int;
1120 -- Mask Environment task for all signals. The original mask of the
1121 -- Environment task will be recovered by Interrupt_Server task
1122 -- during the elaboration of s-interr.adb.
1124 System.Interrupt_Management.Operations.Set_Interrupt_Mask
1125 (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
1127 -- Prepare the set of signals that should unblocked in all tasks
1129 Result := sigemptyset (Unblocked_Signal_Mask'Access);
1130 pragma Assert (Result = 0);
1132 for J in Interrupt_Management.Interrupt_ID loop
1133 if System.Interrupt_Management.Keep_Unmasked (J) then
1134 Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
1135 pragma Assert (Result = 0);
1139 -- Pick the highest resolution Clock for Clock_Realtime
1140 -- ??? This code currently doesn't work (see c94007[ab] for example)
1142 -- if syssgi (SGI_CYCLECNTR_SIZE) = 64 then
1143 -- Real_Time_Clock_Id := CLOCK_SGI_CYCLE;
1145 -- Real_Time_Clock_Id := CLOCK_REALTIME;
1148 end System.Task_Primitives.Operations;