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-2004, 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 DEC Unix 4.0d 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.
43 with System.Tasking.Debug;
44 -- used for Known_Tasks
46 with System.Task_Info;
47 -- used for Task_Info_Type
50 -- used for Shift_Left
56 with System.Interrupt_Management;
57 -- used for Keep_Unmasked
58 -- Abort_Task_Interrupt
61 with System.Interrupt_Management.Operations;
62 -- used for Set_Interrupt_Mask
64 pragma Elaborate_All (System.Interrupt_Management.Operations);
66 with System.Parameters;
70 -- used for Ada_Task_Control_Block
72 -- ATCB components and types
74 with System.Soft_Links;
75 -- used for Defer/Undefer_Abort
77 -- Note that we do not use System.Tasking.Initialization directly since
78 -- this is a higher level package that we shouldn't depend on. For example
79 -- when using the restricted run time, it is replaced by
80 -- System.Tasking.Restricted.Stages.
82 with System.OS_Primitives;
83 -- used for Delay_Modes
85 with Unchecked_Deallocation;
87 package body System.Task_Primitives.Operations is
89 use System.Tasking.Debug;
92 use System.OS_Interface;
93 use System.Parameters;
94 use System.OS_Primitives;
96 package SSL renames System.Soft_Links;
102 -- The followings are logically constants, but need to be initialized
105 Single_RTS_Lock : aliased RTS_Lock;
106 -- This is a lock to allow only one thread of control in the RTS at
107 -- a time; it is used to execute in mutual exclusion from all other tasks.
108 -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
110 ATCB_Key : aliased pthread_key_t;
111 -- Key used to find the Ada Task_Id associated with a thread
113 Environment_Task_Id : Task_Id;
114 -- A variable to hold Task_Id for the environment task.
116 Unblocked_Signal_Mask : aliased sigset_t;
117 -- The set of signals that should unblocked in all tasks
119 Time_Slice_Val : Integer;
120 pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
122 Locking_Policy : Character;
123 pragma Import (C, Locking_Policy, "__gl_locking_policy");
125 Dispatching_Policy : Character;
126 pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
128 FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
129 -- Indicates whether FIFO_Within_Priorities is set.
133 Foreign_Task_Elaborated : aliased Boolean := True;
134 -- Used to identified fake tasks (i.e., non-Ada Threads).
142 procedure Initialize (Environment_Task : Task_Id);
143 pragma Inline (Initialize);
144 -- Initialize various data needed by this package.
146 function Is_Valid_Task return Boolean;
147 pragma Inline (Is_Valid_Task);
148 -- Does executing thread have a TCB?
150 procedure Set (Self_Id : Task_Id);
152 -- Set the self id for the current task.
154 function Self return Task_Id;
155 pragma Inline (Self);
156 -- Return a pointer to the Ada Task Control Block of the calling task.
160 package body Specific is separate;
161 -- The body of this package is target specific.
163 ---------------------------------
164 -- Support for foreign threads --
165 ---------------------------------
167 function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
168 -- Allocate and Initialize a new ATCB for the current Thread.
170 function Register_Foreign_Thread
171 (Thread : Thread_Id) return Task_Id is separate;
173 -----------------------
174 -- Local Subprograms --
175 -----------------------
177 procedure Abort_Handler (Sig : Signal);
178 -- Signal handler used to implement asynchronous abortion.
184 procedure Abort_Handler (Sig : Signal) is
185 pragma Unreferenced (Sig);
187 T : constant Task_Id := Self;
188 Result : Interfaces.C.int;
189 Old_Set : aliased sigset_t;
192 -- It is not safe to raise an exception when using ZCX and the GCC
193 -- exception handling mechanism.
195 if ZCX_By_Default and then GCC_ZCX_Support then
199 if T.Deferral_Level = 0
200 and then T.Pending_ATC_Level < T.ATC_Nesting_Level and then
205 -- Make sure signals used for RTS internal purpose are unmasked
207 Result := pthread_sigmask (SIG_UNBLOCK,
208 Unblocked_Signal_Mask'Unchecked_Access, 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 (T);
224 pragma Unreferenced (On);
233 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
235 return T.Common.LL.Thread;
242 function Self return Task_Id renames Specific.Self;
244 ---------------------
245 -- Initialize_Lock --
246 ---------------------
248 -- Note: mutexes and cond_variables needed per-task basis are
249 -- initialized in Initialize_TCB and the Storage_Error is
250 -- handled. Other mutexes (such as RTS_Lock, Memory_Lock...)
251 -- used in RTS is initialized before any status change of RTS.
252 -- Therefore rasing Storage_Error in the following routines
253 -- should be able to be handled safely.
255 procedure Initialize_Lock
256 (Prio : System.Any_Priority;
259 Attributes : aliased pthread_mutexattr_t;
260 Result : Interfaces.C.int;
263 Result := pthread_mutexattr_init (Attributes'Access);
264 pragma Assert (Result = 0 or else Result = ENOMEM);
266 if Result = ENOMEM then
270 if Locking_Policy = 'C' then
271 L.Ceiling := Interfaces.C.int (Prio);
274 Result := pthread_mutex_init (L.L'Access, Attributes'Access);
275 pragma Assert (Result = 0 or else Result = ENOMEM);
277 if Result = ENOMEM then
278 Result := pthread_mutexattr_destroy (Attributes'Access);
282 Result := pthread_mutexattr_destroy (Attributes'Access);
283 pragma Assert (Result = 0);
286 procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
287 pragma Unreferenced (Level);
289 Attributes : aliased pthread_mutexattr_t;
290 Result : Interfaces.C.int;
293 Result := pthread_mutexattr_init (Attributes'Access);
294 pragma Assert (Result = 0 or else Result = ENOMEM);
296 if Result = ENOMEM then
300 Result := pthread_mutex_init (L, Attributes'Access);
301 pragma Assert (Result = 0 or else Result = ENOMEM);
303 if Result = ENOMEM then
304 Result := pthread_mutexattr_destroy (Attributes'Access);
308 Result := pthread_mutexattr_destroy (Attributes'Access);
309 pragma Assert (Result = 0);
316 procedure Finalize_Lock (L : access Lock) is
317 Result : Interfaces.C.int;
319 Result := pthread_mutex_destroy (L.L'Access);
320 pragma Assert (Result = 0);
323 procedure Finalize_Lock (L : access RTS_Lock) is
324 Result : Interfaces.C.int;
326 Result := pthread_mutex_destroy (L);
327 pragma Assert (Result = 0);
334 procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
335 Result : Interfaces.C.int;
337 All_Tasks_Link : Task_Id;
338 Current_Prio : System.Any_Priority;
341 -- Perform ceiling checks only when this is the locking policy in use.
343 if Locking_Policy = 'C' then
345 All_Tasks_Link := Self_ID.Common.All_Tasks_Link;
346 Current_Prio := Get_Priority (Self_ID);
348 -- If there is no other task, no need to check priorities
350 if All_Tasks_Link /= Null_Task
351 and then L.Ceiling < Interfaces.C.int (Current_Prio)
353 Ceiling_Violation := True;
358 Result := pthread_mutex_lock (L.L'Access);
359 pragma Assert (Result = 0);
361 Ceiling_Violation := False;
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;
400 Result := pthread_mutex_unlock (L.L'Access);
401 pragma Assert (Result = 0);
404 procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
405 Result : Interfaces.C.int;
407 if not Single_Lock or else Global_Lock then
408 Result := pthread_mutex_unlock (L);
409 pragma Assert (Result = 0);
413 procedure Unlock (T : Task_Id) is
414 Result : Interfaces.C.int;
416 if not Single_Lock then
417 Result := pthread_mutex_unlock (T.Common.LL.L'Access);
418 pragma Assert (Result = 0);
428 Reason : System.Tasking.Task_States)
430 pragma Unreferenced (Reason);
432 Result : Interfaces.C.int;
436 Result := pthread_cond_wait
437 (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
439 Result := pthread_cond_wait
440 (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
443 -- EINTR is not considered a failure.
445 pragma Assert (Result = 0 or else Result = EINTR);
452 -- This is for use within the run-time system, so abort is
453 -- assumed to be already deferred, and the caller should be
454 -- holding its own ATCB lock.
456 procedure Timed_Sleep
459 Mode : ST.Delay_Modes;
460 Reason : System.Tasking.Task_States;
461 Timedout : out Boolean;
462 Yielded : out Boolean)
464 pragma Unreferenced (Reason);
466 Check_Time : constant Duration := Monotonic_Clock;
468 Request : aliased timespec;
469 Result : Interfaces.C.int;
475 if Mode = Relative then
476 Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
478 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
481 if Abs_Time > Check_Time then
482 Request := To_Timespec (Abs_Time);
485 exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
486 or else Self_ID.Pending_Priority_Change;
489 Result := pthread_cond_timedwait
490 (Self_ID.Common.LL.CV'Access,
491 Single_RTS_Lock'Access,
495 Result := pthread_cond_timedwait
496 (Self_ID.Common.LL.CV'Access,
497 Self_ID.Common.LL.L'Access,
501 exit when Abs_Time <= Monotonic_Clock;
503 if Result = 0 or Result = EINTR then
505 -- Somebody may have called Wakeup for us
511 pragma Assert (Result = ETIMEDOUT);
520 -- This is for use in implementing delay statements, so
521 -- we assume the caller is abort-deferred but is holding
524 procedure Timed_Delay
527 Mode : ST.Delay_Modes)
529 Check_Time : constant Duration := Monotonic_Clock;
531 Request : aliased timespec;
532 Result : Interfaces.C.int;
535 -- Only the little window between deferring abort and
536 -- locking Self_ID is the reason we need to
537 -- check for pending abort and priority change below! :(
545 Write_Lock (Self_ID);
547 if Mode = Relative then
548 Abs_Time := Time + Check_Time;
550 Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
553 if Abs_Time > Check_Time then
554 Request := To_Timespec (Abs_Time);
555 Self_ID.Common.State := Delay_Sleep;
558 if Self_ID.Pending_Priority_Change then
559 Self_ID.Pending_Priority_Change := False;
560 Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
561 Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
564 exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
567 Result := pthread_cond_timedwait
568 (Self_ID.Common.LL.CV'Access,
569 Single_RTS_Lock'Access,
572 Result := pthread_cond_timedwait (Self_ID.Common.LL.CV'Access,
573 Self_ID.Common.LL.L'Access, Request'Access);
576 exit when Abs_Time <= Monotonic_Clock;
578 pragma Assert (Result = 0 or else
579 Result = ETIMEDOUT or else
583 Self_ID.Common.State := Runnable;
593 SSL.Abort_Undefer.all;
596 ---------------------
597 -- Monotonic_Clock --
598 ---------------------
600 function Monotonic_Clock return Duration is
601 TS : aliased timespec;
602 Result : Interfaces.C.int;
604 Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
605 pragma Assert (Result = 0);
606 return To_Duration (TS);
613 function RT_Resolution return Duration is
615 return 1.0 / 1024.0; -- Clock on DEC Alpha ticks at 1024 Hz
622 procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
623 pragma Unreferenced (Reason);
624 Result : Interfaces.C.int;
626 Result := pthread_cond_signal (T.Common.LL.CV'Access);
627 pragma Assert (Result = 0);
634 procedure Yield (Do_Yield : Boolean := True) is
635 Result : Interfaces.C.int;
636 pragma Unreferenced (Result);
639 Result := sched_yield;
647 procedure Set_Priority
649 Prio : System.Any_Priority;
650 Loss_Of_Inheritance : Boolean := False)
652 pragma Unreferenced (Loss_Of_Inheritance);
654 Result : Interfaces.C.int;
655 Param : aliased struct_sched_param;
658 T.Common.Current_Priority := Prio;
659 Param.sched_priority := Interfaces.C.int (Underlying_Priorities (Prio));
661 if Time_Slice_Val > 0 then
662 Result := pthread_setschedparam
663 (T.Common.LL.Thread, SCHED_RR, Param'Access);
665 elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
666 Result := pthread_setschedparam
667 (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
670 Result := pthread_setschedparam
671 (T.Common.LL.Thread, SCHED_OTHER, Param'Access);
674 pragma Assert (Result = 0);
681 function Get_Priority (T : Task_Id) return System.Any_Priority is
683 return T.Common.Current_Priority;
690 procedure Enter_Task (Self_ID : Task_Id) is
692 Self_ID.Common.LL.Thread := pthread_self;
693 Specific.Set (Self_ID);
697 for J in Known_Tasks'Range loop
698 if Known_Tasks (J) = null then
699 Known_Tasks (J) := Self_ID;
700 Self_ID.Known_Tasks_Index := J;
712 function New_ATCB (Entry_Num : Task_Entry_Index) return Task_Id is
714 return new Ada_Task_Control_Block (Entry_Num);
721 function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task;
723 -----------------------------
724 -- Register_Foreign_Thread --
725 -----------------------------
727 function Register_Foreign_Thread return Task_Id is
729 if Is_Valid_Task then
732 return Register_Foreign_Thread (pthread_self);
734 end Register_Foreign_Thread;
740 procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
741 Mutex_Attr : aliased pthread_mutexattr_t;
742 Result : Interfaces.C.int;
743 Cond_Attr : aliased pthread_condattr_t;
746 if not Single_Lock then
747 Result := pthread_mutexattr_init (Mutex_Attr'Access);
748 pragma Assert (Result = 0 or else Result = ENOMEM);
751 Result := pthread_mutex_init
752 (Self_ID.Common.LL.L'Access, Mutex_Attr'Access);
753 pragma Assert (Result = 0 or else Result = ENOMEM);
761 Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
762 pragma Assert (Result = 0);
765 Result := pthread_condattr_init (Cond_Attr'Access);
766 pragma Assert (Result = 0 or else Result = ENOMEM);
769 Result := pthread_cond_init
770 (Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
771 pragma Assert (Result = 0 or else Result = ENOMEM);
777 if not Single_Lock then
778 Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
779 pragma Assert (Result = 0);
785 Result := pthread_condattr_destroy (Cond_Attr'Access);
786 pragma Assert (Result = 0);
793 procedure Create_Task
795 Wrapper : System.Address;
796 Stack_Size : System.Parameters.Size_Type;
797 Priority : System.Any_Priority;
798 Succeeded : out Boolean)
800 Attributes : aliased pthread_attr_t;
801 Adjusted_Stack_Size : Interfaces.C.size_t;
802 Result : Interfaces.C.int;
803 Param : aliased System.OS_Interface.struct_sched_param;
805 use System.Task_Info;
808 if Stack_Size = Unspecified_Size then
809 Adjusted_Stack_Size := Interfaces.C.size_t (Default_Stack_Size);
811 elsif Stack_Size < Minimum_Stack_Size then
812 Adjusted_Stack_Size := Interfaces.C.size_t (Minimum_Stack_Size);
815 Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
818 Result := pthread_attr_init (Attributes'Access);
819 pragma Assert (Result = 0 or else Result = ENOMEM);
826 Result := pthread_attr_setdetachstate
827 (Attributes'Access, PTHREAD_CREATE_DETACHED);
828 pragma Assert (Result = 0);
830 Result := pthread_attr_setstacksize
831 (Attributes'Access, Adjusted_Stack_Size);
832 pragma Assert (Result = 0);
834 Param.sched_priority :=
835 Interfaces.C.int (Underlying_Priorities (Priority));
836 Result := pthread_attr_setschedparam
837 (Attributes'Access, Param'Access);
838 pragma Assert (Result = 0);
840 if Time_Slice_Val > 0 then
841 Result := pthread_attr_setschedpolicy
842 (Attributes'Access, System.OS_Interface.SCHED_RR);
844 elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
845 Result := pthread_attr_setschedpolicy
846 (Attributes'Access, System.OS_Interface.SCHED_FIFO);
849 Result := pthread_attr_setschedpolicy
850 (Attributes'Access, System.OS_Interface.SCHED_OTHER);
853 pragma Assert (Result = 0);
855 -- Set the scheduling parameters explicitly, since this is the
856 -- only way to force the OS to take e.g. the sched policy and scope
857 -- attributes into account.
859 Result := pthread_attr_setinheritsched
860 (Attributes'Access, PTHREAD_EXPLICIT_SCHED);
861 pragma Assert (Result = 0);
863 T.Common.Current_Priority := Priority;
865 if T.Common.Task_Info /= null then
866 case T.Common.Task_Info.Contention_Scope is
867 when System.Task_Info.Process_Scope =>
868 Result := pthread_attr_setscope
869 (Attributes'Access, PTHREAD_SCOPE_PROCESS);
871 when System.Task_Info.System_Scope =>
872 Result := pthread_attr_setscope
873 (Attributes'Access, PTHREAD_SCOPE_SYSTEM);
875 when System.Task_Info.Default_Scope =>
879 pragma Assert (Result = 0);
882 -- Since the initial signal mask of a thread is inherited from the
883 -- creator, and the Environment task has all its signals masked, we
884 -- do not need to manipulate caller's signal mask at this point.
885 -- All tasks in RTS will have All_Tasks_Mask initially.
887 Result := pthread_create
888 (T.Common.LL.Thread'Access,
890 Thread_Body_Access (Wrapper),
892 pragma Assert (Result = 0 or else Result = EAGAIN);
894 Succeeded := Result = 0;
896 Result := pthread_attr_destroy (Attributes'Access);
897 pragma Assert (Result = 0);
899 if T.Common.Task_Info /= null then
900 -- ??? We're using a process-wide function to implement a task
901 -- specific characteristic.
903 if T.Common.Task_Info.Bind_To_Cpu_Number = 0 then
904 Result := bind_to_cpu (Curpid, 0);
905 elsif T.Common.Task_Info.Bind_To_Cpu_Number > 0 then
906 Result := bind_to_cpu
908 Interfaces.C.unsigned_long (
909 Interfaces.Shift_Left
910 (Interfaces.Unsigned_64'(1),
911 T.Common.Task_Info.Bind_To_Cpu_Number - 1)));
912 pragma Assert (Result = 0);
921 procedure Finalize_TCB (T : Task_Id) is
922 Result : Interfaces.C.int;
924 Is_Self : constant Boolean := T = Self;
926 procedure Free is new
927 Unchecked_Deallocation (Ada_Task_Control_Block, Task_Id);
930 if not Single_Lock then
931 Result := pthread_mutex_destroy (T.Common.LL.L'Access);
932 pragma Assert (Result = 0);
935 Result := pthread_cond_destroy (T.Common.LL.CV'Access);
936 pragma Assert (Result = 0);
938 if T.Known_Tasks_Index /= -1 then
939 Known_Tasks (T.Known_Tasks_Index) := null;
953 procedure Exit_Task is
962 procedure Abort_Task (T : Task_Id) is
963 Result : Interfaces.C.int;
968 Signal (System.Interrupt_Management.Abort_Task_Interrupt));
969 pragma Assert (Result = 0);
978 function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
979 pragma Unreferenced (Self_ID);
988 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
989 pragma Unreferenced (Self_ID);
994 ----------------------
995 -- Environment_Task --
996 ----------------------
998 function Environment_Task return Task_Id is
1000 return Environment_Task_Id;
1001 end Environment_Task;
1007 procedure Lock_RTS is
1009 Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
1016 procedure Unlock_RTS is
1018 Unlock (Single_RTS_Lock'Access, Global_Lock => True);
1025 function Suspend_Task
1027 Thread_Self : Thread_Id) return Boolean
1029 pragma Warnings (Off, T);
1030 pragma Warnings (Off, Thread_Self);
1039 function Resume_Task
1041 Thread_Self : Thread_Id) return Boolean
1043 pragma Warnings (Off, T);
1044 pragma Warnings (Off, Thread_Self);
1053 procedure Initialize (Environment_Task : Task_Id) is
1054 act : aliased struct_sigaction;
1055 old_act : aliased struct_sigaction;
1056 Tmp_Set : aliased sigset_t;
1057 Result : Interfaces.C.int;
1060 (Int : System.Interrupt_Management.Interrupt_ID) return Character;
1061 pragma Import (C, State, "__gnat_get_interrupt_state");
1062 -- Get interrupt state. Defined in a-init.c. The input argument is
1063 -- the interrupt number, and the result is one of the following:
1065 Default : constant Character := 's';
1066 -- 'n' this interrupt not set by any Interrupt_State pragma
1067 -- 'u' Interrupt_State pragma set state to User
1068 -- 'r' Interrupt_State pragma set state to Runtime
1069 -- 's' Interrupt_State pragma set state to System (use "default"
1073 Environment_Task_Id := Environment_Task;
1075 -- Initialize the lock used to synchronize chain of all ATCBs.
1077 Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
1079 Specific.Initialize (Environment_Task);
1081 Enter_Task (Environment_Task);
1083 -- Install the abort-signal handler
1085 if State (System.Interrupt_Management.Abort_Task_Interrupt)
1089 act.sa_handler := Abort_Handler'Address;
1091 Result := sigemptyset (Tmp_Set'Access);
1092 pragma Assert (Result = 0);
1093 act.sa_mask := Tmp_Set;
1097 (Signal (System.Interrupt_Management.Abort_Task_Interrupt),
1098 act'Unchecked_Access,
1099 old_act'Unchecked_Access);
1100 pragma Assert (Result = 0);
1106 Result : Interfaces.C.int;
1109 -- Mask Environment task for all signals. The original mask of the
1110 -- Environment task will be recovered by Interrupt_Server task
1111 -- during the elaboration of s-interr.adb.
1113 System.Interrupt_Management.Operations.Set_Interrupt_Mask
1114 (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
1116 -- Prepare the set of signals that should unblocked in all tasks
1118 Result := sigemptyset (Unblocked_Signal_Mask'Access);
1119 pragma Assert (Result = 0);
1121 for J in Interrupt_Management.Interrupt_ID loop
1122 if System.Interrupt_Management.Keep_Unmasked (J) then
1123 Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
1124 pragma Assert (Result = 0);
1130 end System.Task_Primitives.Operations;