florist_blady_6.1.0_05ac0091/libsrc/threads/posix-signals.adb

------------------------------------------------------------------------------
--                                                                          --
--            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-1997 Florida State University             --
--                     Copyright (C) 1998-2017, AdaCore                     --
--                                                                          --
--  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.                   --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
------------------------------------------------------------------------------

--  Please take care in future maintenance updates to avoid adding
--  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.

--  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 POSIX.Implementation,
     System.Tasking,
     System.Interrupts,
     System.Task_Primitives.Operations,
     Unchecked_Conversion;

package body POSIX.Signals is

   use POSIX.C,
       POSIX.Implementation,
       System,
       System.Storage_Elements;

   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 --
   ------------------

   type Signal_Bit_Vector is array (Signal) of Boolean;

   --  Reserved_Signal is the union of the following sets of
   --  signals:

   --  (1) The reserved signals, as defined
   --  by the POSIX.5 standard.  The reserved signals
   --  include the named required reserved signals, plus any other
   --  signals that are reserved by the implementation.

   --  (2)  The signals for which the
   --  implementation does not allow us to set the action.

   --  (3) The signals for which sigwait is not safe.

   --  (4) The set of signals, as defined by
   --  the Ada runtime system, for which it is unsafe to call
   --  System.Interrupt_Management.Ignore_Signal.

   --  (5) The set of signals, as defined by
   --  the Ada runtime system, for which user-defined signal entries
   --  are not supported.

   --  (6) The set of signals, as defined by
   --  the Ada runtime system, for which it is unsafe to call
   --  System.Interrupt_Management.Block_Signals.

   --  This constant is initialized
   --  in the begin-end block of the package body, below, because
   --  it depends on values in POSIX.Implementation.OK_Signals.

   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
   --  the reserved signals and for signals that are attached to
   --  a task entry.  By extension, we treat signals that are
   --  attached to protected procedures as if they were attached
   --  to a task entry.

   procedure Check_Awaitable
     (Set : Signal_Set) is
   begin
      for Sig in Signal loop
         if Reserved_Signal (Sig) then
            if Sig /= SIGKILL and then Sig /= SIGSTOP and then
              sigismember (Set.C'Unchecked_Access, int (Sig)) = 1
            then
               Raise_POSIX_Error (Invalid_Argument);
            end if;
         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
      pragma Warnings (Off, Ignore);
   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 : 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 not Reserved_Signal (Sig) then
            --  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 : 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));
      for Sig in Signal loop
         if not Reserved_Signal (Sig) then
            --  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 : 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 not Reserved_Signal (Sig) then
            --  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, since
      --  for a badly matched GNARL and operating system, there
      --  may be more values in POSIX.Signal
      --  than System.Interrupts.Interrupt_ID
      if pthread_sigmask
        (SIG_BLOCK, null, Old_Mask.C'Unchecked_Access) = 0
      then
         null;
      end if;
      --  Delete any ublocked signals from System.Interrupts.
      for Sig in Signal loop
         if not Reserved_Signal (Sig) then
            if SI.Is_Blocked (SIID (Sig)) then
               null;
               --  Void (sigaddset (Old_Mask.C'Unchecked_Access, int (Sig)));
               --  Rely that we cannot have a signal that is unmasked
               --  in the current thread and is also logically
               --  blocked by the signal manager.
            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 : Signal) is
   begin
      if 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 : Signal) is
   begin
      if 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
      act : aliased struct_sigaction;
   begin
      if Reserved_Signal (Sig) then
         Raise_POSIX_Error (Invalid_Argument);
         return False;
      else
         Check (sigaction (int (Sig), null, act'Unchecked_Access));
         return act.sa_handler = To_Address (SIG_IGN);
      end if;
   end Is_Ignored;

   ---------------------------
   -- Install_Empty_Handler --
   ---------------------------

   --  This is a POSIX.5c addition.

   --  .... This functionality needs to be merged into the
   --  Ada runtime system (s-interr.adb) so as to ensure mutual
   --  exclusion between these changes to signal handler state
   --  and changes that are done there.
   --  The best solution may be to export operations for
   --  locking/unlocking, rather than to add new entries to the
   --  signal manager task.

   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 --
   ------------------------------

   --  .... This functionality needs to be merged into the
   --  Ada runtime system (s-interr.adb) so as to ensure mutual
   --  exclusion between these changes to signal handler state
   --  and changes that are done there.
   --  The best solution may be to export operations for
   --  locking/unlocking, rather than to add new entries to the
   --  signal manager task.

   procedure Set_Stopped_Child_Signal (Enable : 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   : 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 : 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  : 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  : 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 : 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 : Signal_Data) is
   begin
      Info.si_value := To_sigval (Data);
   end Set_Data;

   -----------------------
   --  Enable_Queueing  --
   -----------------------

   --  .... POSIX.5 needs fixing here, to reflect the fact that
   --  Enabling/Disabling queueing on a signal might not have
   --  any effect unless there is a handler (even null) installed,
   --  or to require that this operation install a null handler,
   --  as a side-effect.

   --  .... This functionality needs to be merged into the
   --  Ada runtime system (s-interr.adb) so as to ensure mutual
   --  exclusion between these changes to signal handler state
   --  and changes that are done there.
   --  The best solution may be to export operations for
   --  locking/unlocking, rather than to add new entries to the
   --  signal manager task.

   procedure Enable_Queueing
     (Sig : 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 : 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  --
   -------------------------------

   function Await_Signal_Or_Timeout
     (Set     : Signal_Set;
      Timeout : POSIX.Timespec) return Signal is
   begin
      return Signal (Await_Signal_Or_Timeout (Set, Timeout).si_signo);
   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 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 : POSIX.Process_Identification.Process_ID;
      Sig     : Signal) is
   begin
      Check (kill (To_pid_t (Process), int (Sig)));
   end Send_Signal;

   -----------------
   -- Send_Signal --
   -----------------

   procedure Send_Signal
     (Group : POSIX.Process_Identification.Process_Group_ID;
      Sig   : Signal) is
   begin
      Check (kill (-To_pid_t (Group), int (Sig)));
   end Send_Signal;

   -----------------
   -- Send_Signal --
   -----------------

   procedure Send_Signal (Sig : 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 : POSIX.Process_Identification.Process_ID;
      Sig     : Signal;
      Data    : Signal_Data) is
   begin
      Check (sigqueue (To_pid_t (Process), int (Sig), To_sigval (Data)));
   end Queue_Signal;

   ----------------------
   --  Interrupt_Task  --
   ----------------------

   procedure Interrupt_Task (T : Ada.Task_Identification.Task_Id) is
   begin
      System.Task_Primitives.Operations.Abort_Task (Convert_Ids (T));
   end Interrupt_Task;

begin
   Reserved_Signal := (others => False);

   for Sig in Signal loop
      case Sig is
      when SIGALRM | SIGBUS | SIGILL | SIGSEGV | SIGFPE | SIGABRT =>
         Reserved_Signal (Sig) := True;
      when SIGKILL | SIGSTOP =>
         Reserved_Signal (Sig) := True;
      when others =>
         Reserved_Signal (Sig) :=
           not POSIX.Implementation.OK_Signals.OK (Integer (Sig));
      end case;
   end loop;

   --  Merge in signals that are reserved by the Ada runtime system.
   for Sig in Signal loop
      pragma Warnings (Off);
      --  Kill warning about condition being always true generated
      --  on some platforms, since this code is meant to be compiled
      --  on several platforms.

      if Integer (Sig) <= Integer (SIID'Last) then
         if SI.Is_Reserved (SIID (Sig)) and then (Sig /= SIGKILL
           and Sig /= SIGSTOP)
         then
            Reserved_Signal (Sig) := True;
         end if;
      else
         Reserved_Signal (Sig) := True;
      end if;

      pragma Warnings (On);
   end loop;
end POSIX.Signals;