------------------------------------------------------------------------------
--                                                                          --
--                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
--                                                                          --
--                S Y S T E M . T A S K I N G . S I G N A L S               --
--                                  B o d y                                 --
--                                                                          --
--                             $Revision: 1.11 $                             --
--                                                                          --
--       Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved        --
--                                                                          --
-- GNARL is free software; you can redistribute it  and/or modify it  under --
-- terms  of  the  GNU  Library General Public License  as published by the --
-- Free Software  Foundation;  either version 2, or (at  your  option)  any --
-- later  version.  GNARL is distributed  in the hope that  it will be use- --
-- ful, but but WITHOUT ANY WARRANTY;  without even the implied warranty of --
-- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
-- eral Library Public License  for more details.  You should have received --
-- a  copy of the GNU Library General Public License along with GNARL;  see --
-- file COPYING.LIB.  If not,  write to the  Free Software Foundation,  675 --
-- Mass Ave, Cambridge, MA 02139, USA.                                      --
--                                                                          --
------------------------------------------------------------------------------

--  This package does not follow the GNARL/GNULL layering. It uses both GNARL
--  and GNULL packages without a clear layer in between.

with System.Error_Reporting;
with System.Storage_Elements;
with System.Task_Primitives; use System.Task_Primitives;
with System.Tasking.Utilities;
with System.Tasking.Rendezvous;
with Interfaces.C.POSIX_Error;
with Interfaces.C.Pthreads;

package body System.Signals is

   package RTE renames Interfaces.c.POSIX_RTE;
   package POSIX_Error renames Interfaces.C.POSIX_Error;

   Failure : Interfaces.C.POSIX_Error.Return_Code
      renames Interfaces.C.POSIX_Error.Failure;

   Assertions_Checked : constant Boolean := True;

   Max_Signal : constant := 32;

   subtype Signal_Index is RTE.Signal range 1 .. Max_Signal - 1;

   type Signal_Assoc is record
      T : Tasking.Task_ID;
      E : Tasking.Task_Entry_Index;
   end record;

   Null_Signal_Assoc : constant Signal_Assoc
      := Signal_Assoc' (T => Tasking.Null_Task, E => Tasking.Null_Task_Entry);

   User_Handler_Table : array (Signal_Index) of Signal_Assoc
     := (others => Null_Signal_Assoc);

   type Server_Info is record
      Task_ID : Tasking.Task_ID;  --  Indivisual signal handling task's Task_ID
      Blocked : boolean;          --  Process level Blocking Indication
      Ignored : boolean;          --  Process level Ignoring Indication
      Asynchronous : boolean;     --  Only Asynchronous signals can have
   end record;                    --  user level handler

   Signal_Server_Table : array (Signal_Index) of Server_Info
      := (RTE.SIGKILL | RTE.SIGSTOP | RTE.SIGALRM | RTE.SIGILL | RTE.SIGFPE |
          RTE.SIGSEGV | RTE.SIGEMT  | RTE.SIGBUS | RTE.SIGTRAP |
          RTE.SIGABRT | RTE.SIGUSR1
      --  These two signals are asynchronous signals according to POSIX
          => (Task_ID      => Tasking.Null_Task,
              Blocked      => false,
              Ignored      => false,
              Asynchronous => false),
          others
          => (Task_ID      => Tasking.Null_Task,
              Blocked      => false,
              Ignored      => false,
              Asynchronous => true));

   task type Handler_Task (S : RTE.Signal);

   --  T : Handler_Task (RTE.SIGABRT);
   --  SIGABRT should also be available for interrupt entry.
   T1  : Handler_Task (RTE.SIGHUP);
   T2  : Handler_Task (RTE.SIGINT);
   T3  : Handler_Task (RTE.SIGPIPE);
   T4  : Handler_Task (RTE.SIGQUIT);
   T5  : Handler_Task (RTE.SIGTERM);
   --  T : Handler_Task (RTE.SIGUSR1);
   --  SIGUSR1 should also be available for interrupt entry.
   T6  : Handler_Task (RTE.SIGUSR2);
   T7  : Handler_Task (RTE.SIGCHLD);
   T8  : Handler_Task (RTE.SIGCONT);
   T9  : Handler_Task (RTE.SIGTSTP);
   T10 : Handler_Task (RTE.SIGTTIN);
   T11 : Handler_Task (RTE.SIGTTOU);

   --  Additional asynchronous signals not required by POSIX
   T12 : Handler_Task (RTE.SIGSYS);
   T13 : Handler_Task (RTE.SIGURG);
   T14 : Handler_Task (RTE.SIGIO);
   T15 : Handler_Task (RTE.SIGXCPU);
   T16 : Handler_Task (RTE.SIGXFSZ);
   T17 : Handler_Task (RTE.SIGVTALRM);
   T18 : Handler_Task (RTE.SIGPROF);
   T19 : Handler_Task (RTE.SIGWINCH);
   T20 : Handler_Task (RTE.SIGLOST);

   task Signal_Manager is
      entry Bind_Handler (T : Tasking.Task_ID;
                          E : Tasking.Task_Entry_Index;
                          S : RTE.Signal);
      entry Unbind_Handler (T : Tasking.Task_ID);
      entry Block_Signal (S : RTE.Signal);
      entry Unblock_Signal (S : RTE.Signal);
   end Signal_Manager;

   M : array (Signal_Index) of Lock;

   C : array (Signal_Index) of Condition_Variable;

   procedure Assert (B : Boolean; M : String)
     renames Error_Reporting.Assert;

   function Address_To_Pointer is new
     Unchecked_Conversion (System.Address, RTE.sigaction_ptr);

   function Address_To_Signal (A : System.Address) return RTE.Signal;

   function Address_To_Signal (A : System.Address) return RTE.Signal is
   begin
      return RTE.Signal (Storage_Elements.To_Integer (A));
   end Address_To_Signal;

   function Address_To_Pointer is new
     Unchecked_Conversion (System.Address, RTE.sigset_t_ptr);

   --  local procedures

   -----------------------
   -- Handler_Installed --
   -----------------------

   function Handler_Installed (S : RTE.Signal) return boolean;

   ----------------------
   -- Server_Installed --
   ----------------------

   function Server_Installed (S : RTE.Signal) return boolean;

   -----------------
   -- Signal_Task --
   -----------------

   procedure Signal_Task (T : Tasking.Task_ID; S : RTE.Signal);

   -------------------------
   -- Thread_Block_Signal --
   -------------------------

   procedure Thread_Block_Signal (S : RTE.Signal);

   ---------------------------
   -- Thread_Unblock_Signal --
   ---------------------------

   procedure Thread_Unblock_Signal (S : RTE.Signal);

   -------------------------
   -- Asynchronous_Signal --
   -------------------------

   function Asynchronous_Signal (S : RTE.Signal) return boolean;

   -------------------------
   -- Initialize_Blocking --
   -------------------------

   procedure Initialize_Blocking;

   ------------------------
   -- Unmask_All_Signals --
   ------------------------

   procedure Unmask_All_Signals;

   ----------------------------
   -- Is_Blocked_Unprotected --
   ----------------------------

   function Is_Blocked_Unprotected
     (S : Interfaces.C.POSIX_RTE.Signal) return boolean;

   ----------------------------
   -- Is_Ignored_Unprotected --
   ----------------------------

   function Is_Ignored_Unprotected
     (S : Interfaces.C.POSIX_RTE.Signal) return boolean;

   --  end of local procedure declaratoins.


   task body Signal_Manager is
      Action : RTE.struct_sigaction;
      Oact : RTE.struct_sigaction;
      Result : Interfaces.C.POSIX_Error.Return_Code;
      Ceiling_Violation : boolean;
   begin
      Unmask_All_Signals;
      --  initially unmask Ref (boundable) signals for which we want
      --  the default action

      Initialize_Blocking;
      --  update the Block_Table to reflect the process level blocked signals

      loop
         select
         accept Bind_Handler (T : Tasking.Task_ID;
                       E : Tasking.Task_Entry_Index;
                       S : RTE.Signal) do
            if not Asynchronous_Signal (S) then
               raise Program_Error;
            end if;

            if Handler_Installed (S) then raise Program_Error; end if;
            --  User should not try to redefine handler before explicitly
            --  detaching it

            Write_Lock (M (S), Ceiling_Violation);

            User_Handler_Table (S) := Signal_Assoc' (T => T, E => E);

            Cond_Signal (C (S));
            --  we have installed a handler if the Handler Task is
            --  waiting to be woke up, do it here.

            if not Is_Blocked_Unprotected (S) then
               Thread_Block_Signal (S);
            end if;
            --  This is the case where signal is not blocked and
            --  handler is installed. We want the handler to catch
            --  signal through sigwait. So mask the signal for this
            --  task.

            Unlock (M (S));

         end Bind_Handler;

         or accept Unbind_Handler (T : Tasking.Task_ID) do

            for I in Signal_Index loop
               Write_Lock (M (I), Ceiling_Violation);
               if User_Handler_Table (I).T = T then
                  User_Handler_Table (I) := Null_Signal_Assoc;
                  RTE.sigaction (I, Address_To_Pointer (Null_Address),
                                 Action, Result);
                  Assert (Result /= Failure, "GNULL failure---sigaction");
                  --  restore the default action in case sigwait ruined it

                  if Is_Ignored_Unprotected (I) then
                     Action.sa_handler :=
                        Storage_Elements.To_Address (RTE.SIG_IGN);
                  else
                     Action.sa_handler :=
                        Storage_Elements.To_Address (RTE.SIG_DFL);
                  end if;

                  RTE.sigaction (I, Action, Oact, Result);
                  Assert (Result /= Failure, "GNULL failure---sigaction");

                  if not Is_Blocked_Unprotected (I) then
                     --  this is the case where the handler is waiting for
                     --  sigwait. We have to wake this up and make it to
                     --  wait on condition variable. Also.
                     --  unmask the signal to allow the default action again

                     Signal_Task (Signal_Server_Table (I).Task_ID, I);
                     Thread_Unblock_Signal (I);
                  end if;
               end if;
               Unlock (M (I));
            end loop;

         end Unbind_Handler;

         or accept Block_Signal (S : RTE.Signal) do
            --  caller holds mutex M (S)
            Thread_Block_Signal (S);
         end Block_Signal;

         or accept Unblock_Signal (S : RTE.Signal) do
            --  caller holds mutex M (S)
            Thread_Unblock_Signal (S);
         end Unblock_Signal;

         or terminate;

         end select;

      end loop;
   end Signal_Manager;

   task body Handler_Task is
      Action : RTE.struct_sigaction;
      Sigwait_Mask : RTE.Signal_Set;
      Sigwait_Signal : RTE.Signal;
      Result : Interfaces.C.POSIX_Error.Return_Code;
      Ceiling_Violation : boolean;
   begin
      Tasking.Utilities.Make_Independent;
      --  By making this task independent of master when process goes away
      --  handler will be terminated gracefully.

      Write_Lock  (M (S), Ceiling_Violation);

      Signal_Server_Table (S).Task_ID := Tasking.Self;
      --  Register the ID of this task so that other can explicitly
      --  send a signal to this task (thread) using pthread_kill

      RTE.Signal_Delete_All (Sigwait_Mask);
      RTE.Signal_Add (Sigwait_Mask, S);

      loop
         if Is_Blocked_Unprotected (S) or else not Handler_Installed (S) then
            Cond_Wait  (C (S), M (S));
            --  This is the place where we have to take the
            --  default action if the signal is not blocked and there is
            --  no handler installed.

            --  wait for Unblock or Bind operation
         else --  wait for actual signal
            Unlock (M (S));

            Interfaces.C.Pthreads.sigwait
               (Sigwait_Mask, Sigwait_Signal, Result);
            Assert (Result /= Failure, "GNULLI failure---sigwait");

            Write_Lock (M (S), Ceiling_Violation);
            if not Is_Blocked_Unprotected (S) and then
              Handler_Installed (S) and then
              not Is_Ignored_Unprotected (S)
            then
               Unlock (M (S));
               Tasking.Rendezvous.Call_Simple
                 (User_Handler_Table (S).T, User_Handler_Table (S).E,
                  System.Null_Address);
               Write_Lock (M (S), Ceiling_Violation);
            end if;
         end if;
      end loop;
      Unlock (M (S));
   end Handler_Task;

   --------------------------
   -- Bind_Signal_To_Entry --
   --------------------------

   procedure Bind_Signal_To_Entry (T : Tasking.Task_ID;
                          E : Tasking.Task_Entry_Index;
                          Sig : System.Address) is
      S : RTE.Signal := Address_To_Signal (Sig);
   begin
      Signal_Manager.Bind_Handler (T, E, S);
   end Bind_Signal_To_Entry;

   --------------------
   -- Detach_Handler --
   --------------------

   procedure Detach_Handler (T : Tasking.Task_ID) is
   begin
      Signal_Manager.Unbind_Handler (T);
   end Detach_Handler;

   ------------------
   -- Block_Signal --
   ------------------

   procedure Block_Signal (S : RTE.Signal) is
      Ceiling_Violation : boolean;
   begin
      Write_Lock (M (S), Ceiling_Violation);
      if not Is_Blocked_Unprotected (S) then
         Signal_Server_Table (S).Blocked := true;
         if Handler_Installed (S) then
            Signal_Task (Signal_Server_Table (S).Task_ID, S);
         else
            Signal_Manager.Block_Signal (S);
         end if;
      end if;
      Unlock (M (S));
   end Block_Signal;

   ---------------------
   -- Unlock_Signal --
   ---------------------

   procedure Unblock_Signal (S : RTE.Signal) is
      Ceiling_Violation : boolean;
   begin
      Write_Lock (M (S), Ceiling_Violation);
      if Is_Blocked_Unprotected (S) then
         Signal_Server_Table (S).Blocked := false;
         if Handler_Installed (S) then
            Cond_Signal (C (S));
            --  should make this to wait on sigwait instead cond variable
         else
            Signal_Manager.Unblock_Signal (S);
         end if;
      end if;
      Unlock (M (S));
   end Unblock_Signal;

   ----------------
   -- Is_Blocked --
   ----------------

   function Is_Blocked (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
      Tmp : boolean;
      Ceiling_Violation : boolean;
   begin
      Write_Lock (M (S), Ceiling_Violation);
      Tmp :=  Signal_Server_Table (S).Blocked;
      Unlock (M (S));
      return Tmp;
   end Is_Blocked;

   ----------------
   -- Is_Ignored --
   ----------------

   function Is_Ignored (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
      Tmp : boolean;
      Ceiling_Violation : boolean;
   begin
      Write_Lock (M (S), Ceiling_Violation);
      Tmp := Signal_Server_Table (S).Ignored;
      Unlock (M (S));
      return Tmp;
   end Is_Ignored;


   -------------------
   -- Ignore_Signal --
   -------------------

   procedure Ignore_Signal (S : RTE.Signal) is
      Action : RTE.struct_sigaction;
      Oact : RTE.struct_sigaction;
      Result : Interfaces.C.POSIX_Error.Return_Code;
      Ceiling_Violation : boolean;
   begin
      Write_Lock (M (S), Ceiling_Violation);
      if not Is_Ignored_Unprotected (S) then
         RTE.sigaction (S, Address_To_Pointer (Null_Address),
                        Action, Result);
         Action.sa_handler := Storage_Elements.To_Address (RTE.SIG_IGN);
         RTE.sigaction (S, Action, Oact, Result);
         Assert (Result /= Failure, "GNULL failure---sigaction");
         Signal_Server_Table (S).Ignored := true;
      end if;
      Unlock (M (S));
   end Ignore_Signal;

   ---------------------
   -- Unignore_Signal --
   ---------------------

   procedure Unignore_Signal (S : RTE.Signal) is
      Action : RTE.struct_sigaction;
      Oact : RTE.struct_sigaction;
      Result : Interfaces.C.POSIX_Error.Return_Code;
      Ceiling_Violation : boolean;
   begin
      Write_Lock (M (S), Ceiling_Violation);
      if Is_Ignored_Unprotected (S) then
         RTE.sigaction (S, Address_To_Pointer (Null_Address),
                        Action, Result);
         Action.sa_handler := Storage_Elements.To_Address (RTE.SIG_DFL);
         RTE.sigaction (S, Action, Oact, Result);
         Assert (Result /= Failure, "GNULL failure---sigaction");
         Signal_Server_Table (S).Ignored := false;
      end if;
      Unlock (M (S));
   end Unignore_Signal;

   -----------------------
   -- Handler_Installed --
   -----------------------

   function Handler_Installed (S : RTE.Signal) return boolean is
   begin
      return User_Handler_Table (S) /= Null_Signal_Assoc;
   end Handler_Installed;

   ----------------------
   -- Server_Installed --
   ----------------------

   function Server_Installed (S : RTE.Signal) return boolean is
   begin
      return Signal_Server_Table (S).Task_ID /= Tasking.Null_Task;
   end Server_Installed;

   -------------------
   --  Signal_Task  --
   -------------------

   procedure Signal_Task (T : Tasking.Task_ID; S : RTE.Signal) is
      T_Access : Task_Primitives.TCB_Ptr :=
                   Utilities.ID_To_ATCB (T).LL_TCB'Access;
      Result : Interfaces.C.POSIX_Error.Return_Code;
   begin
      Interfaces.C.Pthreads.pthread_kill
         (T_Access.Thread, S, Result);
      Assert (Result /= Failure, "GNULLI failure---pthread_kill");
   end Signal_Task;

   -------------------------
   -- Thread_Block_Signal --
   -------------------------

   procedure Thread_Block_Signal (S : RTE.Signal) is
      Signal_Mask, Old_Set : RTE.Signal_Set;
      Result : Interfaces.C.POSIX_Error.Return_Code;
   begin
      RTE.Signal_Delete_All (Signal_Mask);
      RTE.Signal_Add (Signal_Mask, S);
      RTE.sigprocmask (RTE.SIG_BLOCK, Signal_Mask, Old_Set, Result);
      Assert (Result /= Failure, "GNULLI failure---sigprocmask");
   end Thread_Block_Signal;

   ---------------------------
   -- Thread_Unblock_Signal --
   ---------------------------

   procedure Thread_Unblock_Signal (S : RTE.Signal) is
      Signal_Mask, Old_Set : RTE.Signal_Set;
      Result : Interfaces.C.POSIX_Error.Return_Code;
   begin
      RTE.Signal_Delete_All (Signal_Mask);
      RTE.Signal_Add (Signal_Mask, S);
      RTE.sigprocmask (RTE.SIG_UNBLOCK, Signal_Mask, Old_Set, Result);
      Assert (Result /= Failure, "GNULLI failure---sigprocmask");
   end Thread_Unblock_Signal;

   -------------------------
   -- Asynchronous_Signal --
   -------------------------

   function Asynchronous_Signal (S : RTE.Signal) return boolean is
   begin
      return Signal_Server_Table (S).Asynchronous;
   end Asynchronous_Signal;

   -------------------------
   -- Initialize_Blocking --
   -------------------------

   procedure Initialize_Blocking is
      Signal_Mask, Old_Set : RTE.Signal_Set;
      Result : Interfaces.C.POSIX_Error.Return_Code;
   begin
      RTE.sigprocmask (RTE.SIG_BLOCK, Address_To_Pointer (System.Null_Address),
                       Signal_Mask, Result);
      Assert (Result /= Failure, "GNULL failure---sigprocmask");
      for I in Signal_Index loop
         if RTE.Member_Of (Signal_Mask, I) then
            Signal_Server_Table (I).Blocked := true;
         end if;
      end loop;
   end Initialize_Blocking;

   ------------------------
   -- Unmask_All_Signals --
   ------------------------

   --  Unmask asynchronous signals for calling thread.

   procedure Unmask_All_Signals is
      Signal_Mask, Old_Set : RTE.Signal_Set;
      Result : Interfaces.C.POSIX_Error.Return_Code;
   begin
      RTE.Signal_Delete_All (Signal_Mask);
      --  RTE.Signal_Add (Signal_Mask, RTE.SIGABRT);
      RTE.Signal_Add (Signal_Mask, RTE.SIGHUP);
      RTE.Signal_Add (Signal_Mask, RTE.SIGINT);
      RTE.Signal_Add (Signal_Mask, RTE.SIGPIPE);
      RTE.Signal_Add (Signal_Mask, RTE.SIGQUIT);
      RTE.Signal_Add (Signal_Mask, RTE.SIGTERM);
      --  RTE.Signal_Add (Signal_Mask, RTE.SIGUSR1);
      RTE.Signal_Add (Signal_Mask, RTE.SIGUSR2);
      RTE.Signal_Add (Signal_Mask, RTE.SIGCHLD);
      RTE.Signal_Add (Signal_Mask, RTE.SIGCONT);
      RTE.Signal_Add (Signal_Mask, RTE.SIGTSTP);
      RTE.Signal_Add (Signal_Mask, RTE.SIGTTIN);
      RTE.Signal_Add (Signal_Mask, RTE.SIGTTOU);

      --  Not POSIX required signals
      RTE.Signal_Add (Signal_Mask, RTE.SIGSYS);
      RTE.Signal_Add (Signal_Mask, RTE.SIGURG);
      RTE.Signal_Add (Signal_Mask, RTE.SIGIO);
      RTE.Signal_Add (Signal_Mask, RTE.SIGXCPU);
      RTE.Signal_Add (Signal_Mask, RTE.SIGXFSZ);
      RTE.Signal_Add (Signal_Mask, RTE.SIGVTALRM);
      RTE.Signal_Add (Signal_Mask, RTE.SIGPROF);
      RTE.Signal_Add (Signal_Mask, RTE.SIGWINCH);
      RTE.Signal_Add (Signal_Mask, RTE.SIGLOST);

      RTE.sigprocmask (RTE.SIG_UNBLOCK, Signal_Mask, Old_Set, Result);
      Assert (Result /= Failure, "GNULL failure---sigprocmask");
   end Unmask_All_Signals;

   ----------------------------
   -- Is_Blocked_Unprotected --
   ----------------------------

   function Is_Blocked_Unprotected
     (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
   begin
      return Signal_Server_Table (S).Blocked;
   end Is_Blocked_Unprotected;

   ----------------------------
   -- Is_Ignored_Unprotected --
   ----------------------------

   function Is_Ignored_Unprotected
     (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
   begin
      return Signal_Server_Table (S).Ignored;
   end Is_Ignored_Unprotected;

end System.Signals;
