diff options
Diffstat (limited to 'gcc/ada/s-taprop-vxworks.adb')
| -rw-r--r-- | gcc/ada/s-taprop-vxworks.adb | 59 |
1 files changed, 25 insertions, 34 deletions
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 3186f6fb962..207b465c579 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -78,40 +78,34 @@ package body System.Task_Primitives.Operations is -- The followings are logically constants, but need to be initialized at -- run time. - Single_RTS_Lock : aliased RTS_Lock; - -- This is a lock to allow only one thread of control in the RTS at a - -- time; it is used to execute in mutual exclusion from all other tasks. - -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - Environment_Task_Id : Task_Id; -- A variable to hold Task_Id for the environment task - Unblocked_Signal_Mask : aliased sigset_t; - -- The set of signals that should unblocked in all tasks - -- The followings are internal configuration constants needed - Time_Slice_Val : Integer; - pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); + Dispatching_Policy : Character; + pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); + + Foreign_Task_Elaborated : aliased Boolean := True; + -- Used to identified fake tasks (i.e., non-Ada Threads) Locking_Policy : Character; pragma Import (C, Locking_Policy, "__gl_locking_policy"); - Dispatching_Policy : Character; - pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); - Mutex_Protocol : Priority_Type; - Foreign_Task_Elaborated : aliased Boolean := True; - -- Used to identified fake tasks (i.e., non-Ada Threads) + Signal_Mask : aliased sigset_t; + pragma Import (C, Signal_Mask, "__gnat_signal_mask"); + -- Mask indicating that all exception signals are to be masked + -- when a signal is propagated. - type Set_Stack_Limit_Proc_Acc is access procedure; - pragma Convention (C, Set_Stack_Limit_Proc_Acc); + Single_RTS_Lock : aliased RTS_Lock; + -- This is a lock to allow only one thread of control in the RTS at a + -- time; it is used to execute in mutual exclusion from all other tasks. + -- Used mainly in Single_Lock mode, but also to protect All_Tasks_List - Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc; - pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook"); - -- Procedure to be called when a task is created to set stack - -- limit. + Time_Slice_Val : Integer; + pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); -------------------- -- Local Packages -- @@ -168,6 +162,14 @@ package body System.Task_Primitives.Operations is -- This function returns True if the current execution is in the context -- of a task, and False if it is an interrupt context. + type Set_Stack_Limit_Proc_Acc is access procedure; + pragma Convention (C, Set_Stack_Limit_Proc_Acc); + + Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc; + pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook"); + -- Procedure to be called when a task is created to set stack + -- limit. Used only for VxWorks 5 and VxWorks MILS guest OS. + function To_Address is new Ada.Unchecked_Conversion (Task_Id, System.Address); @@ -180,7 +182,6 @@ package body System.Task_Primitives.Operations is Self_ID : constant Task_Id := Self; Old_Set : aliased sigset_t; - Result : int; pragma Warnings (Off, Result); @@ -198,12 +199,12 @@ package body System.Task_Primitives.Operations is then Self_ID.Aborting := True; - -- Make sure signals used for RTS internal purpose are unmasked + -- Make sure signals used for RTS internal purposes are unmasked Result := pthread_sigmask (SIG_UNBLOCK, - Unblocked_Signal_Mask'Access, + Signal_Mask'Access, Old_Set'Access); pragma Assert (Result = 0); @@ -1380,16 +1381,6 @@ package body System.Task_Primitives.Operations is end if; - Result := sigemptyset (Unblocked_Signal_Mask'Access); - pragma Assert (Result = 0); - - for J in Interrupt_Management.Signal_ID loop - if System.Interrupt_Management.Keep_Unmasked (J) then - Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J)); - pragma Assert (Result = 0); - end if; - end loop; - -- Initialize the lock used to synchronize chain of all ATCBs Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); |
