File : posix-signals.adb
pragma Source_Reference (1, "posix-signals.gpb");
------------------------------------------------------------------------------
-- --
-- FLORIST (FSU Implementation of POSIX.5) COMPONENTS --
-- --
-- P O S I X . S I G N A L S --
-- --
-- B o d y --
-- --
-- --
-- Copyright (c) 1996-1998 Florida State University (FSU). All Rights --
-- Reserved. --
-- --
-- This file is a component of FLORIST, an implementation of an Ada API --
-- for the POSIX OS services, for use with the GNAT Ada compiler and --
-- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended --
-- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD --
-- 1003.5b: 1996. --
-- --
-- FLORIST is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. FLORIST is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty --
-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. You should have received a --
-- copy of the GNU General Public License distributed with GNARL; see --
-- file COPYING. If not, write to the Free Software Foundation, 59 --
-- Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
------------------------------------------------------------------------------
-- [$Revision: 1.2 $]
-- Please take care in future maintenance updates to avoid making
-- direct system calls that modify the signal action or signal
-- masking, and to coordinate changes with the GNAT runtime.
-- The implementation of this package is closely dependent on the
-- GNAT packages System.Interrupts, and
-- System.Interrupt_Management. See comments in those packages
-- for related explanation of the design for signal handling.
-- Unfortunately, this means maintenance changes to Florist and
-- GNAT need to be synchronized. A person with an older version of
-- GNAT will have problems using the current version of Florist.
-- The present design is a compromise. If it were not for the
-- backward compatibility issue, all of the necessary POSIX
-- signal management support would be implemented directly in
-- the package System.Interrupts. (That was the original design.)
-- We have tried to avoid changing the GNARL runtime system package
-- interfaces, in order that it would be possible to compile Florist
-- using earlier versions of GNAT. This has meant in some cases
-- putting the implementation of new functionality (e.g., the
-- POSIX.5b Interrupt_Task and the POSIX.5c Install_Empty_Handler)
-- directly into the body of POSIX.Signals. As a result, the
-- functionality is now divided between the two packages, in a
-- way that may not make much sense to a new reader.
-- With luck, it should be possible to compile this version of Florist
-- with earlier versions of GNAT. There will a variable degree of
-- effect on the functioning of the signal management interfaces.
-- Since there were significant defects in this part of earlier releases
-- of Florist (detected by the POSIX.5b validation tests), we hope
-- no earlier Florist users are dependent on the way these operations
-- "worked" before. We had to make the changes.
-- If the version of GNAT is out of sync with the version of Florist
-- there will be two distinct degrees of "reserved" signals.
-- 1) Signals that the OS does not allow us to accept with sigwait or to
-- block with pthread_sigmask, or which are required to be reserved by
-- the POSIX Ada binding standard.
-- We call these "Reserved_Signals".
-- 2) Signals that the GNAT runtime system reserves, and so we cannot
-- pass to operations like SI.Block_Signal.
-- We call these "SI_Reserved_Signals".
-- For simplicity, we merge Reserved_Signals into SI_Reserved_Signals,
-- so that we Resered_Signals is a subset of SI_Reserved_Signals.
-- If the versions of Florist and GNAT are in sync., these two sets
-- of reserved signals should be identical.
-- Ideally, there should be no operations in here that directly modify the
-- signal state of the process or thread. For safety, all such operations
-- should be implemented by calls to operations in System.Interrupts.
-- Otherwise, we could break invariants upon which the Ada tasking
-- runtime system depends. However, to allow this version of Florist
-- to be used with earlier versions of GNAT, there are some places where
-- direct system calls are done. People doing maintenance should beware
-- of adding other direct calls without careful analysis of how they
-- might interact with what the GNAT runtime system is doing.
with Ada.Task_Identification,
POSIX,
POSIX.C,
POSIX.Implementation,
POSIX.Implementation.OK_Signals,
System,
System.Storage_Elements,
System.Tasking,
System.Interrupts,
System.Interrupt_Management,
System.Task_Primitives.Operations;
package body POSIX.Signals is
use POSIX.C,
POSIX.Implementation,
System,
System.Storage_Elements,
System.Tasking;
package SI renames System.Interrupts;
subtype SIID is SI.Interrupt_ID;
package Bogus_Signal_Enum is
package PS renames POSIX.Signals;
type Signal_Name_Enum is
(Signal_Null,
SIGNULL,
Signal_Abort,
SIGABRT,
Signal_Alarm,
SIGALRM,
Signal_Bus_Error,
SIGBUS,
Signal_Floating_Point_Error,
SIGFPE,
Signal_Hangup,
SIGHUP,
Signal_Illegal_Instruction,
SIGILL,
Signal_Interrupt,
SIGINT,
Signal_Kill,
SIGKILL,
Signal_Pipe_Write,
SIGPIPE,
Signal_Quit,
SIGQUIT,
Signal_Segmentation_Violation,
SIGSEGV,
Signal_Terminate,
SIGTERM,
Signal_User_1,
SIGUSR1,
Signal_User_2,
SIGUSR2,
Signal_Child,
SIGCHLD,
Signal_Continue,
SIGCONT,
Signal_Stop,
SIGSTOP,
Signal_Terminal_Stop,
SIGTSTP,
Signal_Terminal_Input,
SIGTTIN,
Signal_Terminal_Output,
SIGTTOU,
Signal_IO,
SIGIO,
Signal_Out_Of_Band_Data,
SIGURG);
Enum_To_Signal : array (Signal_Name_Enum'Range) of Signal :=
(Signal_Null => 0,
SIGNULL => 0,
Signal_Abort => PS.SIGABRT,
SIGABRT => PS.SIGABRT,
Signal_Alarm => PS.SIGALRM,
SIGALRM => PS.SIGALRM,
Signal_Bus_Error => PS.SIGBUS,
SIGBUS => PS.SIGBUS,
Signal_Floating_Point_Error => PS.SIGFPE,
SIGFPE => PS.SIGFPE,
Signal_Hangup => PS.SIGHUP,
SIGHUP => PS.SIGHUP,
Signal_Illegal_Instruction => PS.SIGILL,
SIGILL => PS.SIGILL,
Signal_Interrupt => PS.SIGINT,
SIGINT => PS.SIGINT,
Signal_Kill => PS.SIGKILL,
SIGKILL => PS.SIGKILL,
Signal_Pipe_Write => PS.SIGPIPE,
SIGPIPE => PS.SIGPIPE,
Signal_Quit => PS.SIGQUIT,
SIGQUIT => PS.SIGQUIT,
Signal_Segmentation_Violation => PS.SIGSEGV,
SIGSEGV => PS.SIGSEGV,
Signal_Terminate => PS.SIGTERM,
SIGTERM => PS.SIGTERM,
Signal_User_1 => PS.SIGUSR1,
SIGUSR1 => PS.SIGUSR1,
Signal_User_2 => PS.SIGUSR2,
SIGUSR2 => PS.SIGUSR2,
Signal_Child => PS.SIGCHLD,
SIGCHLD => PS.SIGCHLD,
Signal_Continue => PS.SIGCONT,
SIGCONT => PS.SIGCONT,
Signal_Stop => PS.SIGSTOP,
SIGSTOP => PS.SIGSTOP,
Signal_Terminal_Stop => PS.SIGTSTP,
SIGTSTP => PS.SIGTSTP,
Signal_Terminal_Input => PS.SIGTTIN,
SIGTTIN => PS.SIGTTIN,
Signal_Terminal_Output => PS.SIGTTOU,
SIGTTOU => PS.SIGTTOU,
Signal_IO => PS.SIGIO,
SIGIO => PS.SIGIO,
Signal_Out_Of_Band_Data => PS.SIGURG,
SIGURG => PS.SIGURG);
Signal_To_Enum : array (Signal'Range) of Signal_Name_Enum :=
(0 => Signal_Null,
PS.SIGABRT => Signal_Abort,
PS.SIGALRM => Signal_Alarm,
PS.SIGBUS => Signal_Bus_Error,
PS.SIGFPE => Signal_Floating_Point_Error,
PS.SIGHUP => Signal_Hangup,
PS.SIGILL => Signal_Illegal_Instruction,
PS.SIGINT => Signal_Interrupt,
PS.SIGKILL => Signal_Kill,
PS.SIGPIPE => Signal_Pipe_Write,
PS.SIGQUIT => Signal_Quit,
PS.SIGSEGV => Signal_Segmentation_Violation,
PS.SIGTERM => Signal_Terminate,
PS.SIGUSR1 => Signal_User_1,
PS.SIGUSR2 => Signal_User_2,
PS.SIGCHLD => Signal_Child,
PS.SIGCONT => Signal_Continue,
PS.SIGSTOP => Signal_Stop,
PS.SIGTSTP => Signal_Terminal_Stop,
PS.SIGTTIN => Signal_Terminal_Input,
PS.SIGTTOU => Signal_Terminal_Output,
PS.SIGIO => Signal_IO,
PS.SIGURG => Signal_Out_Of_Band_Data,
others => Signal_Null);
end Bogus_Signal_Enum;
use Bogus_Signal_Enum;
------------------
-- Global Data --
------------------
Last_Unblocker : array (Signal) of Task_ID :=
(others => Null_Task);
pragma Volatile_Components (Last_Unblocker);
-- Holds the ID of the last Task which Unblocked this Interrupt.
-- It contains Null_Task if no tasks have ever requested the
-- Unblocking operation or the Interrupt is currently Blocked.
-- Reserved_Signal is the set of reserved signals, as defined
-- by the POSIX.5 standard, augmented with the unblockable and
-- uncatchable signals, SIGKILL and SIGSTOP. The reserved signals
-- includes the named required reserved signals, plus any other
-- signals that are reserved by the implementation. It is initialized
-- in the begin-end block of the package body, below.
type Signal_Bit_Vector is array (Signal) of Boolean;
Reserved_Signal : Signal_Bit_Vector;
-- SI_Reserved_Signal is the set of signals that are safe to pass to
-- calls the operations of System.Interrupts, such as SI.Block_Signal.
-- These signals also cannot be attached to Ada task entries.
-- (This need not be the same as Reserved_Signal.)
SI_Reserved_Signal : Signal_Bit_Vector;
-- Signal_Disposition is use by Set_Blocked_Signals, to decide who
-- should mask or unmask a given signal.
type Signal_Disposition is
(No_Change,
SI_To_Mask,
SI_To_Unmask);
------------------------
-- Local Subprograms --
------------------------
function To_pid_t is new Unchecked_Conversion
(POSIX.Process_Identification.Process_ID, pid_t);
function To_pid_t is new Unchecked_Conversion
(POSIX.Process_Identification.Process_Group_ID, pid_t);
function Convert_Ids is new Unchecked_Conversion
(Ada.Task_Identification.Task_Id, System.Tasking.Task_ID);
function To_Signal_Data is new Unchecked_Conversion (sigval, Signal_Data);
function To_sigval is new Unchecked_Conversion (Signal_Data, sigval);
function sigismember (set : sigset_t_ptr; sig : int) return int;
pragma Import (C, sigismember, sigismember_LINKNAME);
function sigaddset (set : access sigset_t; sig : int) return int;
pragma Import (C, sigaddset, sigaddset_LINKNAME);
function sigfillset (set : access sigset_t) return int;
pragma Import (C, sigfillset, sigfillset_LINKNAME);
function sigemptyset (set : access sigset_t) return int;
pragma Import (C, sigemptyset, sigemptyset_LINKNAME);
function sigdelset (set : access sigset_t; sig : int) return int;
pragma Import (C, sigdelset, sigdelset_LINKNAME);
function sigpending (set : sigset_t_ptr) return int;
pragma Import (C, sigpending, sigpending_LINKNAME);
function sigaction
(sig : int;
act : sigaction_ptr;
oact : sigaction_ptr)
return int;
pragma Import (C, sigaction, sigaction_LINKNAME);
function pthread_sigmask
(how : int;
set : sigset_t_ptr;
oset : sigset_t_ptr) return int;
pragma Import (C, pthread_sigmask, pthread_sigmask_LINKNAME);
function sigwait
(set : sigset_t_ptr;
sig : int_ptr) return int;
pragma Import (C, sigwait, sigwait_LINKNAME);
function sigwaitinfo
(set : sigset_t_ptr; info : siginfo_t_ptr) return int;
pragma Import (C, sigwaitinfo, sigwaitinfo_LINKNAME);
function sigtimedwait
(set : sigset_t_ptr;
info : siginfo_t_ptr;
timeout : timespec_ptr) return int;
pragma Import (C, sigtimedwait, sigtimedwait_LINKNAME);
procedure Check_Awaitable (Set : Signal_Set);
pragma Inline (Check_Awaitable);
procedure Null_Handler;
pragma Convention (C, Null_Handler);
procedure Void (Ignore : int);
pragma Inline (Void);
-- The Await_Signal operations report Invalid_Argument for
-- SIGKILL, SIGSTOP, and the reserved signals.
procedure Check_Awaitable
(Set : Signal_Set) is
begin
for Sig in Signal loop
if Reserved_Signal (Sig) then
-- The OS will not allow using sigwait with this signal.
if sigismember (Set.C'Unchecked_Access, int (Sig)) = 1 then
Raise_POSIX_Error (Invalid_Argument);
end if;
elsif SI_Reserved_Signal (Sig) then
-- The Ada runtime system will not allow attaching this signal
-- to a task entry or protected procedure, but we can use it
-- safely with sigwait.
null;
else
-- This signal might be attached to a
-- task entry or protected procedure
if sigismember (Set.C'Unchecked_Access, int (Sig)) = 1
and then (SI.Is_Entry_Attached (SIID (Sig))
or else SI.Is_Handler_Attached (SIID (Sig))) then
Raise_POSIX_Error (Invalid_Argument);
end if;
end if;
end loop;
end Check_Awaitable;
procedure Null_Handler is
begin
null;
end Null_Handler;
procedure Void (Ignore : int) is
begin
null;
end Void;
----------------------------------------
-- Signal_Set Initialize and Finalize --
----------------------------------------
procedure Initialize (Set : in out Signal_Set) is
begin
Void (sigemptyset (Set.C'Unchecked_Access));
end Initialize;
procedure Finalize (Set : in out Signal_Set) is
begin
Void (sigemptyset (Set.C'Unchecked_Access));
end Finalize;
-----------
-- Image --
-----------
function Image (Sig : Signal) return String is
Tmp : constant Signal_Name_Enum := Signal_To_Enum (Sig);
begin
if Tmp = Bogus_Signal_Enum.Signal_Null and then Sig /= 0 then
declare
Img : constant String := Signal'Image (Sig);
begin
return "SIGNAL_" & Img (Img'First + 1 .. Img'Last);
end;
else
return Signal_Name_Enum'Image (Tmp);
end if;
end Image;
-----------
-- Value --
-----------
function Value (Str : String) return Signal is
A : constant Positive := Str'First;
begin
if Str'Length > 7 and then Str (A .. A + 6) = "SIGNAL_"
and then Str (A + 7) in '0' .. '9'
then
return Signal'Value (Str (A + 7 .. Str'Last));
else
return Enum_To_Signal (Signal_Name_Enum'Value (Str));
end if;
end Value;
----------------
-- Add_Signal --
----------------
procedure Add_Signal (Set : in out Signal_Set; Sig : Signal) is
begin
if Sig /= Signal_Null then
Void (sigaddset (Set.C'Unchecked_Access, int (Sig)));
end if;
-- Signal_Null (i.e., zero) is implicitly a member of every set.
end Add_Signal;
--------------------
-- Add_All_Signal --
--------------------
procedure Add_All_Signals (Set : in out Signal_Set) is
begin
Void (sigfillset (Set.C'Unchecked_Access));
end Add_All_Signals;
-------------------
-- Delete_Signal --
-------------------
procedure Delete_Signal (Set : in out Signal_Set; Sig : Signal) is
begin
if Sig /= Signal_Null then
Void (sigdelset (Set.C'Unchecked_Access, int (Sig)));
end if;
end Delete_Signal;
------------------------
-- Delete_All_Signals --
------------------------
procedure Delete_All_Signals (Set : in out Signal_Set) is
begin
if sigemptyset (Set.C'Unchecked_Access) = 0 then
null;
end if;
end Delete_All_Signals;
---------------
-- Is_Member --
---------------
function Is_Member
(Set : Signal_Set; Sig : Signal) return Boolean is
begin
if Sig = Signal_Null
or else sigismember (Set.C'Unchecked_Access, int (Sig)) = 1 then
return True;
end if;
return False;
end Is_Member;
-----------------------------------
-- Set_Blocked_Signals --
-----------------------------------
-- The operations that block/unblock signals do not raise an
-- exception for any reserved or uncatchable signals, but
-- quietly have no effect on the masking of SIGKILL, SIGSTOP,
-- and the reserved signals.
procedure Set_Blocked_Signals
(New_Mask : in Signal_Set;
Old_Mask : out Signal_Set) is
os_new_mask : aliased sigset_t;
Prev_Mask : Signal_Set;
Disposition : array (Signal) of Signal_Disposition :=
(others => No_Change);
begin
Begin_Critical_Section;
Prev_Mask := Blocked_Signals;
Void (pthread_sigmask
(SIG_SETMASK, null, os_new_mask'Unchecked_Access));
-- Partition the signals between those that
-- are managed by System.Interrupts and those that we manage
-- directly here.
for Sig in Signal loop
if SI_Reserved_Signal (Sig) then
-- The OS and/or Ada runtime system will not allow us to
-- change the mask of this signal.
null;
else
-- It is OK to modify this signal's masking, using the
-- interfaces of System.Interrupts.
if sigismember
(New_Mask.C'Unchecked_Access, int (Sig)) = 1 then
if not SI.Is_Blocked (SIID (Sig)) then
Disposition (Sig) := SI_To_Mask;
end if;
else
if SI.Is_Blocked (SIID (Sig)) then
Disposition (Sig) := SI_To_Unmask;
end if;
end if;
end if;
end loop;
-- Update the record of which task has which signal unblocked.
for Sig in Signal loop
case Disposition (Sig) is
when No_Change => null;
when SI_To_Mask =>
SI.Block_Interrupt (SIID (Sig));
-- ???? Rely that no exception can be raised, due to previous
-- checks? Otherwise, we need to provide a handler to end the
-- critical section.
when SI_To_Unmask =>
SI.Unblock_Interrupt (SIID (Sig));
-- ???? Rely that no exception can be raised, due to previous
-- checks? Otherwise, we need to provide a handler to end the
-- critical section.
end case;
end loop;
End_Critical_Section;
Old_Mask := Prev_Mask;
end Set_Blocked_Signals;
---------------------
-- Block_Signals --
---------------------
procedure Block_Signals
(Mask_to_Add : in Signal_Set;
Old_Mask : out Signal_Set) is
os_new_mask : aliased sigset_t;
Prev_Mask : Signal_Set;
Disposition : array (Signal) of Signal_Disposition :=
(others => No_Change);
begin
Begin_Critical_Section;
Prev_Mask := Blocked_Signals;
Void (sigemptyset (os_new_mask'Unchecked_Access));
-- Partition the signals between those that
-- are managed by System.Interrupts and those that we manage
-- directly here.
for Sig in Signal loop
if SI_Reserved_Signal (Sig) then
-- The OS and/or Ada runtime system will not allow us to
-- change the mask of this signal.
null;
else
-- It is OK to modify this signal's masking, using the
-- interfaces of System.Interrupts.
if sigismember
(Mask_to_Add.C'Unchecked_Access, int (Sig)) = 1 then
if not SI.Is_Blocked (SIID (Sig)) then
Disposition (Sig) := SI_To_Mask;
end if;
else
null;
end if;
end if;
end loop;
-- Update the record of which task has which signal unblocked.
for Sig in Signal loop
case Disposition (Sig) is
when No_Change => null;
when SI_To_Mask =>
SI.Block_Interrupt (SIID (Sig));
-- ???? Rely that no exception can be raised, due to previous
-- checks? Otherwise, we need to provide a handler to end the
-- critical section.
when SI_To_Unmask =>
-- Should never get here!
raise Program_Error;
end case;
end loop;
End_Critical_Section;
Old_Mask := Prev_Mask;
end Block_Signals;
-----------------------
-- Unblock_Signals --
-----------------------
procedure Unblock_Signals
(Mask_to_Subtract : in Signal_Set;
Old_Mask : out Signal_Set) is
os_new_mask : aliased sigset_t;
Prev_Mask : Signal_Set;
Disposition : array (Signal) of Signal_Disposition :=
(others => No_Change);
begin
Begin_Critical_Section;
Prev_Mask := Blocked_Signals;
Void (sigemptyset (os_new_mask'Unchecked_Access));
-- Partition the signals between those that
-- are managed by System.Interrupts and those that we manage
-- directly here.
for Sig in Signal loop
if SI_Reserved_Signal (Sig) then
-- The OS and/or Ada runtime system will not allow us to
-- change the mask of this signal.
null;
else
-- It is OK to modify this signal's masking, using the
-- interfaces of System.Interrupts.
if sigismember
(Mask_to_Subtract.C'Unchecked_Access, int (Sig)) = 1 then
if SI.Is_Blocked (SIID (Sig)) then
Disposition (Sig) := SI_To_Unmask;
end if;
end if;
end if;
end loop;
-- Update the record of which task has which signal unblocked.
for Sig in Signal loop
case Disposition (Sig) is
when No_Change => null;
when SI_To_Mask =>
raise Program_Error;
-- Should never get here!
when SI_To_Unmask =>
SI.Unblock_Interrupt (SIID (Sig));
-- ???? Rely that no exception can be raised, due to previous
-- checks? Otherwise, we need to provide a handler to end the
-- critical section.
end case;
end loop;
End_Critical_Section;
Old_Mask := Prev_Mask;
end Unblock_Signals;
-----------------------
-- Blocked_Signals --
-----------------------
function Blocked_Signals return Signal_Set is
Old_Mask : Signal_Set;
begin
-- Get thread-level signal mask, directly from OS.
if pthread_sigmask
(SIG_BLOCK, null, Old_Mask.C'Unchecked_Access) = 0 then
null;
end if;
-- Merge in view from System.Interrupts.
for Sig in Signal loop
if not SI_Reserved_Signal (Sig) then
if SI.Is_Blocked (SIID (Sig)) then
Void (sigaddset (Old_Mask.C'Unchecked_Access, int (Sig)));
else
Void (sigdelset (Old_Mask.C'Unchecked_Access, int (Sig)));
end if;
end if;
end loop;
return Old_Mask;
end Blocked_Signals;
-------------------
-- Ignore_Signal --
-------------------
-- The signal ignoring/unignoring operations report
-- Invalid_Operation for SIGKILL, SIGSTOP, the reserved signals,
-- Signal_Null, or any other signals for which the signal action
-- is not permitted to be set by an application.
procedure Ignore_Signal (Sig : in Signal) is
begin
if SI_Reserved_Signal (Sig) then
Raise_POSIX_Error (Invalid_Argument);
else
SI.Ignore_Interrupt (SIID (Sig));
end if;
end Ignore_Signal;
---------------------
-- Unignore_Signal --
---------------------
procedure Unignore_Signal (Sig : in Signal) is
begin
if SI_Reserved_Signal (Sig) then
Raise_POSIX_Error (Invalid_Argument);
else
SI.Unignore_Interrupt (SIID (Sig));
end if;
end Unignore_Signal;
----------------
-- Is_Ignored --
----------------
function Is_Ignored (Sig : Signal) return Boolean is
begin
if SI_Reserved_Signal (Sig) then
Raise_POSIX_Error (Invalid_Argument);
return False;
else
return SI.Is_Ignored (SIID (Sig));
end if;
end Is_Ignored;
---------------------------
-- Install_Empty_Handler --
---------------------------
-- This is a POSIX.5c addition.
procedure Install_Empty_Handler (Sig : Signal) is
act, oact : aliased struct_sigaction;
Result : int;
begin
if Reserved_Signal (Sig) then
Raise_POSIX_Error (Invalid_Argument);
end if;
Begin_Critical_Section;
act.sa_flags := 0;
act.sa_handler := Null_Handler'Address;
Check (sigemptyset (act.sa_mask'Unrestricted_Access));
Result := sigaction (int (Sig),
act'Unchecked_Access, oact'Unchecked_Access);
End_Critical_Section;
Check (Result);
end Install_Empty_Handler;
------------------------------
-- Set_Stopped_Child_Signal --
------------------------------
procedure Set_Stopped_Child_Signal (Enable : in Boolean := True) is
Action, Oact : aliased struct_sigaction;
Result : int;
begin
Begin_Critical_Section;
-- ... Need to coordinate with System.Interrupts
-- to enforce mutual exclusion on signal state changes
Result := sigaction (POSIX.C.SIGCHLD, null, Oact'Unchecked_Access);
if Result /= -1 then
Action := Oact;
-- .... need to check that this feature is really supported
-- and raise POSIX_Error, if it is not, else we will have some
-- strange effects from the default values of these constants!!
-- In general, should look at various systems to see which features
-- are not supported, and make sure we are fail-safe if those
-- features are missing.
if Enable then
Action.sa_flags :=
int (Bits (Action.sa_flags) and not SA_NOCLDSTOP);
else
Action.sa_flags :=
int (Bits (Action.sa_flags) or SA_NOCLDSTOP);
end if;
Result := sigaction
(POSIX.C.SIGCHLD, Action'Unchecked_Access, Oact'Unchecked_Access);
end if;
End_Critical_Section;
Check (Result);
end Set_Stopped_Child_Signal;
----------------------------------
-- Stopped_Child_Signal_Enabled --
----------------------------------
function Stopped_Child_Signal_Enabled return Boolean is
Action : aliased struct_sigaction;
Result : int;
begin
Begin_Critical_Section;
Result := sigaction (POSIX.C.SIGCHLD, null, Action'Unchecked_Access);
End_Critical_Section;
Check (Result);
return ((Bits (Action.sa_flags) and SA_NOCLDSTOP) = 0);
end Stopped_Child_Signal_Enabled;
---------------------
-- Pending_Signals --
---------------------
function Pending_Signals return Signal_Set is
Set : Signal_Set;
Result : int;
begin
Begin_Critical_Section;
Result := sigpending (Set.C'Unchecked_Access);
End_Critical_Section;
Check (Result);
return Set;
end Pending_Signals;
------------------
-- Get_Signal --
------------------
function Get_Signal (Event : Signal_Event) return Signal is
begin
return Signal (Event.sigev_signo);
end Get_Signal;
------------------
-- Set_Signal --
------------------
procedure Set_Signal
(Event : in out Signal_Event;
Sig : in Signal) is
begin
Event.sigev_signo := int (Sig);
end Set_Signal;
------------------------
-- Get_Notification --
------------------------
function Get_Notification (Event : Signal_Event) return Notification is
begin
return Notification (Event.sigev_notify);
end Get_Notification;
------------------------
-- Set_Notification --
------------------------
procedure Set_Notification
(Event : in out Signal_Event;
Notify : in Notification) is
begin
Event.sigev_notify := int (Notify);
end Set_Notification;
----------------
-- Get_Data --
----------------
function Get_Data (Event : Signal_Event) return Signal_Data is
begin
return To_Signal_Data (Event.sigev_value);
end Get_Data;
----------------
-- Set_Data --
----------------
procedure Set_Data
(Event : in out Signal_Event;
Data : in Signal_Data) is
begin
Event.sigev_value := To_sigval (Data);
end Set_Data;
------------------
-- Get_Signal --
------------------
function Get_Signal (Info : Signal_Info) return Signal is
begin
return Signal (Info.si_signo);
end Get_Signal;
------------------
-- Set_Signal --
------------------
procedure Set_Signal
(Info : in out Signal_Info;
Sig : in Signal) is
begin
Info.si_signo := int (Sig);
end Set_Signal;
------------------
-- Get_Source --
------------------
function Get_Source (Info : Signal_Info) return Signal_Source is
begin
return Signal_Source (Info.si_code);
end Get_Source;
------------------
-- Set_Source --
------------------
procedure Set_Source
(Info : in out Signal_Info;
Source : in Signal_Source) is
begin
Info.si_code := int (Source);
end Set_Source;
----------------
-- Has_Data --
----------------
function Has_Data (Source : Signal_Source) return Boolean is
begin
return (Source = From_Queue_Signal) or (Source = From_Async_IO)
or (Source = From_Message_Queue) or (Source = From_Timer);
end Has_Data;
----------------
-- Get_Data --
----------------
function Get_Data (Info : Signal_Info) return Signal_Data is
begin
return To_Signal_Data (Info.si_value);
end Get_Data;
----------------
-- Set_Data --
----------------
procedure Set_Data
(Info : in out Signal_Info;
Data : in Signal_Data) is
begin
Info.si_value := To_sigval (Data);
end Set_Data;
-----------------------
-- Enable_Queueing --
-----------------------
procedure Enable_Queueing
(Sig : in Signal) is
Action : aliased struct_sigaction;
Result : int;
begin
if not HAVE_sigqueue then
Raise_POSIX_Error (Operation_Not_Supported);
end if;
Begin_Critical_Section;
Result := sigaction (int (Sig), null, Action'Unchecked_Access);
if Result /= -1 then
Action.sa_flags := int (Bits (Action.sa_flags) or SA_SIGINFO);
Result := sigaction (int (Sig), Action'Unchecked_Access, null);
end if;
End_Critical_Section;
Check (Result);
end Enable_Queueing;
------------------------
-- Disable_Queueing --
------------------------
procedure Disable_Queueing (Sig : in Signal) is
Action : aliased struct_sigaction;
Result : int;
begin
if not HAVE_sigqueue then
Raise_POSIX_Error (Operation_Not_Supported);
end if;
Begin_Critical_Section;
Result := sigaction (int (Sig), null, Action'Unchecked_Access);
if Result /= -1 then
Action.sa_flags := int (Bits (Action.sa_flags) and not SA_SIGINFO);
Result := sigaction (int (Sig), Action'Unchecked_Access, null);
end if;
End_Critical_Section;
end Disable_Queueing;
--------------------
-- Await_Signal --
--------------------
function Await_Signal (Set : Signal_Set) return Signal is
Result : aliased int;
begin
Check_Awaitable (Set);
if sigwait
(Set.C'Unchecked_Access, Result'Unchecked_Access) = -1 then
Raise_POSIX_Error (Fetch_Errno);
end if;
return Signal (Result);
end Await_Signal;
-------------------------------
-- Await_Signal_Or_Timeout --
-------------------------------
-- POSIX only provides a timeout on sigwaitinfo.
-- We can implement this using "sigwaitinfo" if the system
-- supports that optional feature, by just ignoring the "info".
-- We have implemented this using an ATC. However, sigwait
-- (Interrupt_Wait) is not an Async-Safe operation. We wanted to put
-- a Defer/Undefer_Abortion around it but that would make this operation
-- hang when the time expires.
-- The following commented-out code is work-around developed earlier
-- for use with the Provenzano/MIT threads, where sigwait is not
-- interruptible. (See sigwait.c)
-- package SIM renames System.Interrupt_Management;
-- package SIMO renames System.Interrupt_Management.Operations;
-- function Await_Signal_Or_Timeout
-- (Set : Signal_Set;
-- Timeout : POSIX.Timespec) return Signal is
-- Result : SIM.SIID := SIM.SIID (Signal_Null);
-- Int_Mask : aliased SIM.Interrupt_Mask;
-- Start_Time : POSIX_Time := Clock;
-- begin
-- select
-- delay To_Duration (Timeout);
-- Raise_POSIX_Error (Resource_Temporarily_Unavailable);
-- -- In case the ATC is timed out before the abortable part
-- -- went into the "sigwait."
-- then abort
-- SIMO.Empty_Interrupt_Mask (Int_Mask'Unchecked_Access);
-- for I in Signal_Set'Range loop
-- if Set (I) then
-- SIMO.Add_To_Interrupt_Mask
-- (Int_Mask'Unchecked_Access, SIM.SIID (I));
-- end if;
-- end loop;
-- SIMO.Add_To_Interrupt_Mask
-- (Int_Mask'Unchecked_Access, SIM.Abort_Task_Interrupt);
-- -- Add Abort_Task_Interrupt In the waiting set.
-- Defer_Abortion;
-- Result := SIMO.Interrupt_Wait (Int_Mask'Unchecked_Access);
-- -- Beware that this is a non-standard use of sigwait.
-- -- The effect of sigwait on sigaction is undefined.
-- -- This works for pre-Leroy-threads Linux and Solaris,
-- -- but with Leroy threads it seems to fail.
-- Undefer_Abortion;
-- if Signal (Result) = Signal_Null then
-- Raise_POSIX_Error (Fetch_Errno);
-- end if;
-- end select;
-- if Signal (Result) = Signal (SIM.Abort_Task_Interrupt) then
-- if Clock > Start_Time + To_Duration (Timeout) then
-- -- If it is being aborted it is due to the timer expiration.
-- Raise_POSIX_Error (Resource_Temporarily_Unavailable);
-- else
-- pragma Assert (False);
-- -- Undefer_Abortion should have raised Abort_Signal
-- end if;
-- end if;
-- return Signal (Result);
-- end Await_Signal_Or_Timeout;
function Await_Signal_Or_Timeout
(Set : Signal_Set;
Timeout : POSIX.Timespec) return Signal is
Tmp1, Tmp2, Result : aliased int;
Tmp_Set : Signal_Set := Set;
oact : aliased struct_sigaction;
begin
Check_Awaitable (Set);
select
delay To_Duration (Timeout);
Raise_POSIX_Error (Resource_Temporarily_Unavailable);
then abort
Void (sigaddset (Tmp_Set.C'Unchecked_Access, int (SIGABRT)));
Defer_Abortion;
Tmp1 := sigaction (int (SIGABRT),
null, oact'Unchecked_Access);
Tmp2 := sigwait
(Tmp_Set.C'Unchecked_Access, Result'Unchecked_Access);
Tmp1 := sigaction (int (SIGABRT),
oact'Unchecked_Access, null);
Undefer_Abortion;
if Tmp2 = -1 then
Raise_POSIX_Error (Fetch_Errno);
end if;
if Result = int (SIGABRT) then
raise Program_Error;
end if;
end select;
return Signal (Result);
end Await_Signal_Or_Timeout;
--------------------
-- Await_Signal --
--------------------
function Await_Signal (Set : Signal_Set) return Signal_Info is
Info : aliased siginfo_t;
begin
Check_Awaitable (Set);
Check (sigwaitinfo (Set.C'Unchecked_Access, Info'Unchecked_Access));
return Signal_Info (Info);
end Await_Signal;
-------------------------------
-- Await_Signal_Or_Timeout --
-------------------------------
function Await_Signal_Or_Timeout
(Set : Signal_Set; Timeout : POSIX.Timespec) return Signal_Info is
c_timeout : aliased struct_timespec;
Info : aliased siginfo_t;
S : Seconds;
NS : Nanoseconds;
begin
Check_Awaitable (Set);
Split (Timeout, S, NS);
c_timeout.tv_sec := time_t (S);
c_timeout.tv_nsec := long (NS);
Check (sigtimedwait
(Set.C'Unchecked_Access,
Info'Unchecked_Access,
c_timeout'Unchecked_Access));
return Signal_Info (Info);
end Await_Signal_Or_Timeout;
------------------------
-- Signal_Reference --
------------------------
function Signal_Reference (Sig : Signal) return System.Address is
begin
-- Signal_Reference reports Invalid_Argument if signal entries
-- are not supported for the specified signal.
if SI_Reserved_Signal (Sig) then
Raise_POSIX_Error (Invalid_Argument);
end if;
return To_Address (Integer_Address (Sig));
end Signal_Reference;
-----------------
-- Send_Signal --
-----------------
function kill (pid : pid_t; sig : C.int) return int;
pragma Import (C, kill, kill_LINKNAME);
procedure Send_Signal
(Process : in POSIX.Process_Identification.Process_ID;
Sig : in Signal) is
begin
Check (kill (To_pid_t (Process), int (Sig)));
end Send_Signal;
-----------------
-- Send_Signal --
-----------------
procedure Send_Signal
(Group : in POSIX.Process_Identification.Process_Group_ID;
Sig : in Signal) is
begin
Check (kill (-To_pid_t (Group), int (Sig)));
end Send_Signal;
-----------------
-- Send_Signal --
-----------------
procedure Send_Signal (Sig : in Signal) is
begin
Check (kill (0, int (Sig)));
end Send_Signal;
--------------------
-- Queue_Signal --
--------------------
function sigqueue
(pid : pid_t;
signo : int;
value : sigval) return int;
pragma Import (C, sigqueue, sigqueue_LINKNAME);
procedure Queue_Signal
(Process : in POSIX.Process_Identification.Process_ID;
Sig : in Signal;
Data : in Signal_Data) is
begin
Check (sigqueue (To_pid_t (Process), int (Sig), To_sigval (Data)));
end Queue_Signal;
----------------------
-- Interrupt_Task --
----------------------
procedure Interrupt_Task (T : in Ada.Task_Identification.Task_Id) is
begin
System.Task_Primitives.Operations.Abort_Task (Convert_Ids (T));
end Interrupt_Task;
begin
for Sig in Signal loop
case Sig is
when SIGALRM | SIGBUS | SIGILL | SIGSEGV | SIGFPE | SIGABRT |
SIGKILL | SIGSTOP =>
Reserved_Signal (Sig) := True;
when others =>
Reserved_Signal (Sig) :=
not POSIX.Implementation.OK_Signals.OK (Integer (Sig));
end case;
end loop;
SI_Reserved_Signal := Reserved_Signal;
-- Merge in signals that are reserved by the Ada runtime system.
for Sig in Signal loop
if SIID'Base (Sig) in SIID'Range then
if SI.Is_Reserved (SIID (Sig)) then
SI_Reserved_Signal (Sig) := True;
end if;
else SI_Reserved_Signal (Sig) := True;
end if;
end loop;
-- Temporary hack....trust the runtime system.
Reserved_Signal := SI_Reserved_Signal;
-- .....Fix POSIX.5?????
-- There is presently no portable way to catch SIGCHLD, since
-- the default action is to ignore it, and the OS is allowed to
-- throw away ignored signals even when the signal is masked.
-- This is also true of other signals for which the default action
-- is to ignore the signal. The following is a temporary hack.
-- It would be better to fix this in GNARL.
-- See also the comments on Install_Empty_Handler.
for Sig in Signal loop
if not Reserved_Signal (Sig)
and then POSIX.Implementation.OK_Signals.No_Default (Integer (Sig))
then
Install_Empty_Handler (Sig);
end if;
end loop;
end POSIX.Signals;