home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-bin / lib / gcc-lib / m68k-amigaos / 2.7.2.1 / adainclude / s-signal.adb < prev    next >
Encoding:
Text File  |  1995-10-17  |  24.8 KB  |  703 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  4. --                                                                          --
  5. --                         S Y S T E M . S I G N A L S                      --
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.21 $                            --
  10. --                                                                          --
  11. --       Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNARL is free software; you can redistribute it  and/or modify it  under --
  14. -- terms  of  the  GNU  Library General Public License  as published by the --
  15. -- Free Software  Foundation;  either version 2, or (at  your  option)  any --
  16. -- later  version.  GNARL is distributed  in the hope that  it will be use- --
  17. -- ful, but but WITHOUT ANY WARRANTY;  without even the implied warranty of --
  18. -- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  19. -- eral Library Public License  for more details.  You should have received --
  20. -- a  copy of the GNU Library General Public License along with GNARL;  see --
  21. -- file COPYING.LIB.  If not,  write to the  Free Software Foundation,  675 --
  22. -- Mass Ave, Cambridge, MA 02139, USA.                                      --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  This package does not follow the GNARL/GNULL layering. It uses both GNARL
  27. --  and GNULL packages without a clear layer in between.
  28.  
  29. --  Full Dot5 sementics are not fully implemented yet.
  30. --  To be reconsidered ???
  31.  
  32. with System.Storage_Elements;
  33. with System.Task_Primitives; use System.Task_Primitives;
  34. with System.Tasking.Utilities;
  35. with System.Tasking.Rendezvous;
  36. with Interfaces.C.POSIX_Error;
  37. with Interfaces.C.Pthreads;
  38.  
  39. package body System.Signals is
  40.  
  41.    package RTE renames Interfaces.c.POSIX_RTE;
  42.    package POSIX_Error renames Interfaces.C.POSIX_Error;
  43.  
  44.    Failure : Interfaces.C.POSIX_Error.Return_Code
  45.       renames Interfaces.C.POSIX_Error.Failure;
  46.  
  47.    Max_Signal : constant := RTE.NSIG;
  48.  
  49.    subtype Signal_Index is RTE.Signal range 1 .. Max_Signal - 1;
  50.  
  51.    type Signal_Entry_Assoc is record
  52.       T : Tasking.Task_ID;
  53.       E : Tasking.Task_Entry_Index;
  54.    end record;
  55.  
  56.    Null_Signal_Entry_Assoc : constant Signal_Entry_Assoc :=
  57.      Signal_Entry_Assoc'
  58.        (T => Tasking.Null_Task, E => Tasking.Null_Task_Entry);
  59.  
  60.    User_Handler_Table : array (Signal_Index) of Signal_Entry_Assoc
  61.      := (others => Null_Signal_Entry_Assoc);
  62.  
  63.    type Server_Info is record
  64.       Task_ID : Tasking.Task_ID;  --  Indivisual signal handling task's Task_ID
  65.       Blocked : boolean;          --  Process level Blocking Indication
  66.       Ignored : boolean;          --  Process level Ignoring Indication
  67.       Asynchronous : boolean;     --  Only Asynchronous signals may have
  68.    end record;                    --  user level handler
  69.  
  70.    type Signal_Server_Array is array (Signal_Index) of Server_Info;
  71.  
  72.    Signal_Server_Table : Signal_Server_Array;
  73.  
  74.    task type Handler_Task (S : RTE.Signal);
  75.    type Handler_Task_Access is access Handler_Task;
  76.  
  77.    Handler_Access : array (Signal_Index) of  Handler_Task_Access;
  78.  
  79.    task Signal_Manager is
  80.       entry Bind_Handler   (T : Tasking.Task_ID;
  81.                             E : Tasking.Task_Entry_Index;
  82.                             S : RTE.Signal);
  83.       entry Unbind_Handler (T : Tasking.Task_ID);
  84.       entry Block_Signal   (S : RTE.Signal);
  85.       entry Unblock_Signal (S : RTE.Signal);
  86.    end Signal_Manager;
  87.  
  88.    M : array (Signal_Index) of Lock;
  89.  
  90.    C : array (Signal_Index) of Condition_Variable;
  91.  
  92.    function Address_To_Pointer is new
  93.      Unchecked_Conversion (System.Address, RTE.sigaction_ptr);
  94.  
  95.    function Address_To_Signal (A : System.Address) return RTE.Signal;
  96.  
  97.    function Address_To_Signal (A : System.Address) return RTE.Signal is
  98.    begin
  99.       return RTE.Signal (Storage_Elements.To_Integer (A));
  100.    end Address_To_Signal;
  101.  
  102.    function Address_To_Pointer is new
  103.      Unchecked_Conversion (System.Address, RTE.sigset_t_ptr);
  104.  
  105.    --  local procedures
  106.  
  107.    -----------------------
  108.    -- Handler_Installed --
  109.    -----------------------
  110.  
  111.    function Handler_Installed (S : RTE.Signal) return boolean;
  112.  
  113.    ----------------------
  114.    -- Server_Installed --
  115.    ----------------------
  116.  
  117.    function Server_Installed (S : RTE.Signal) return boolean;
  118.  
  119.    -----------------
  120.    -- Signal_Task --
  121.    -----------------
  122.  
  123.    procedure Signal_Task (T : Tasking.Task_ID; S : RTE.Signal);
  124.  
  125.    -------------------------
  126.    -- Thread_Block_Signal --
  127.    -------------------------
  128.  
  129.    procedure Thread_Block_Signal (S : RTE.Signal);
  130.  
  131.    ---------------------------
  132.    -- Thread_Unblock_Signal --
  133.    ---------------------------
  134.  
  135.    procedure Thread_Unblock_Signal (S : RTE.Signal);
  136.  
  137.    -------------------------
  138.    -- Asynchronous_Signal --
  139.    -------------------------
  140.  
  141.    function Asynchronous_Signal (S : RTE.Signal) return boolean;
  142.  
  143.    -------------------------
  144.    -- Initialize_Blocking --
  145.    -------------------------
  146.  
  147.    procedure Initialize_Blocking;
  148.  
  149.    ------------------------
  150.    -- Unmask_All_Signals --
  151.    ------------------------
  152.  
  153.    procedure Unmask_All_Signals;
  154.  
  155.    ----------------------------
  156.    -- Is_Blocked_Unprotected --
  157.    ----------------------------
  158.  
  159.    function Is_Blocked_Unprotected
  160.      (S : Interfaces.C.POSIX_RTE.Signal) return boolean;
  161.  
  162.    ----------------------------
  163.    -- Is_Ignored_Unprotected --
  164.    ----------------------------
  165.  
  166.    function Is_Ignored_Unprotected
  167.      (S : Interfaces.C.POSIX_RTE.Signal) return boolean;
  168.  
  169.    ------------------------------
  170.    -- Init_Signal_Server_Table --
  171.    ------------------------------
  172.  
  173.    procedure Init_Signal_Server_Table;
  174.  
  175.    --  end of local procedure declaratoins.
  176.  
  177.  
  178.    task body Signal_Manager is
  179.       Action : aliased RTE.struct_sigaction;
  180.       Oact   : aliased RTE.struct_sigaction;
  181.       Result : Interfaces.C.POSIX_Error.Return_Code;
  182.       Ceiling_Violation : boolean;
  183.    begin
  184.       Unmask_All_Signals;
  185.       --  initially unmask Ref (boundable) signals for which we want
  186.       --  the default action
  187.  
  188.       Initialize_Blocking;
  189.       --  update the Block_Table to reflect the process level blocked signals
  190.  
  191.       loop
  192.          select
  193.          accept Bind_Handler (T : Tasking.Task_ID;
  194.                        E : Tasking.Task_Entry_Index;
  195.                        S : RTE.Signal) do
  196.  
  197.             Cond_Signal (C (S));
  198.             --  we have installed a handler before we called this entry.
  199.             --  if the Handler Task is waiting to be woke up, do it here.
  200.  
  201.             if not Is_Blocked_Unprotected (S) then
  202.                Thread_Block_Signal (S);
  203.             end if;
  204.             --  This is the case where signal is not blocked and
  205.             --  handler is installed. We want the handler to catch
  206.             --  signal through sigwait. So mask the signal for this
  207.             --  task.
  208.  
  209.          end Bind_Handler;
  210.  
  211.          or accept Unbind_Handler (T : Tasking.Task_ID) do
  212.  
  213.             for I in Signal_Index loop
  214.                Write_Lock (M (I), Ceiling_Violation);
  215.                if User_Handler_Table (I).T = T then
  216.                   User_Handler_Table (I) := Null_Signal_Entry_Assoc;
  217.                   RTE.sigaction (I, Action'Access, Result);
  218.                   pragma Assert (Result /= Failure or else
  219.                     Utilities.Runtime_Assert_Shutdown (
  220.                       "Signals Failure---sigaction"));
  221.                   --  restore the default action in case sigwait ruined it
  222.  
  223.                   if Is_Ignored_Unprotected (I) then
  224.                      Action.sa_handler :=
  225.                         Storage_Elements.To_Address (RTE.SIG_IGN);
  226.                   else
  227.                      Action.sa_handler :=
  228.                         Storage_Elements.To_Address (RTE.SIG_DFL);
  229.                   end if;
  230.  
  231.                   RTE.sigaction (I, Action'Access, Oact'Access, Result);
  232.                   pragma Assert (Result /= Failure or else
  233.                     Utilities.Runtime_Assert_Shutdown (
  234.                       "Signals Failure---sigaction"));
  235.  
  236.                   if not Is_Blocked_Unprotected (I) then
  237.                      --  this is the case where the handler is waiting for
  238.                      --  sigwait. We have to wake this up and make it to
  239.                      --  wait on condition variable. Also.
  240.                      --  unmask the signal to allow the default action again
  241.  
  242.                      Signal_Task (Signal_Server_Table (I).Task_ID, I);
  243.                      Thread_Unblock_Signal (I);
  244.                   end if;
  245.                end if;
  246.                Unlock (M (I));
  247.             end loop;
  248.  
  249.          end Unbind_Handler;
  250.  
  251.          or accept Block_Signal (S : RTE.Signal) do
  252.             --  caller holds mutex M (S)
  253.             Thread_Block_Signal (S);
  254.          end Block_Signal;
  255.  
  256.          or accept Unblock_Signal (S : RTE.Signal) do
  257.             --  caller holds mutex M (S)
  258.             Thread_Unblock_Signal (S);
  259.          end Unblock_Signal;
  260.  
  261.          or terminate;
  262.  
  263.          end select;
  264.  
  265.       end loop;
  266.    end Signal_Manager;
  267.  
  268.    task body Handler_Task is
  269.       Action         : aliased RTE.struct_sigaction;
  270.       Sigwait_Mask   : aliased RTE.Signal_Set;
  271.       Sigwait_Signal : RTE.Signal;
  272.       Result         : Interfaces.C.POSIX_Error.Return_Code;
  273.       Ceiling_Violation : boolean;
  274.    begin
  275.       Tasking.Utilities.Make_Independent;
  276.       --  By making this task independent of master, when the process goes away
  277.       --  handler will be terminated gracefully.
  278.  
  279.       Write_Lock  (M (S), Ceiling_Violation);
  280.  
  281.       Signal_Server_Table (S).Task_ID := Tasking.Self;
  282.       --  Register the ID of this task so that other can explicitly
  283.       --  send a signal to this task (thread) using pthread_kill
  284.  
  285.       RTE.sigemptyset (Sigwait_Mask'Access, Result);
  286.       pragma Assert (Result /= Failure or else
  287.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigemptyset"));
  288.       RTE.sigaddset (Sigwait_Mask'Access, S, Result);
  289.       pragma Assert (Result /= Failure or else
  290.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  291.  
  292.       loop
  293.          if Is_Blocked_Unprotected (S) or else not Handler_Installed (S) then
  294.             Cond_Wait  (C (S), M (S));
  295.             --  This is the place where we have to take the
  296.             --  default action if the signal is not blocked and there is
  297.             --  no handler installed.
  298.  
  299.             --  wait for Unblock or Bind operation
  300.          else --  wait for actual signal
  301.             Unlock (M (S));
  302.  
  303.             Interfaces.C.Pthreads.sigwait
  304.                (Sigwait_Mask, Sigwait_Signal, Result);
  305.             pragma Assert (Result /= Failure or else
  306.               Utilities.Runtime_Assert_Shutdown ("GNULLI failure---sigwait"));
  307.  
  308.             Write_Lock (M (S), Ceiling_Violation);
  309.             if not Is_Blocked_Unprotected (S) and then
  310.               Handler_Installed (S) and then
  311.               not Is_Ignored_Unprotected (S)
  312.             then
  313.                Unlock (M (S));
  314.                Tasking.Rendezvous.Call_Simple
  315.                  (User_Handler_Table (S).T, User_Handler_Table (S).E,
  316.                   System.Null_Address);
  317.                Write_Lock (M (S), Ceiling_Violation);
  318.             end if;
  319.          end if;
  320.       end loop;
  321.       Unlock (M (S));
  322.    end Handler_Task;
  323.  
  324.    --------------------------
  325.    -- Bind_Signal_To_Entry --
  326.    --------------------------
  327.  
  328.    procedure Bind_Signal_To_Entry (T : Tasking.Task_ID;
  329.                           E : Tasking.Task_Entry_Index;
  330.                           Sig : System.Address) is
  331.       S : RTE.Signal := Address_To_Signal (Sig);
  332.       Ceiling_Violation : boolean;
  333.    begin
  334.       Write_Lock (M (S), Ceiling_Violation);
  335.  
  336.       if not Asynchronous_Signal (S) then
  337.          raise Program_Error;
  338.       end if;
  339.  
  340.       if Handler_Installed (S) then raise Program_Error; end if;
  341.       --  User should not try to redefine handler before explicitly
  342.       --  detaching it
  343.  
  344.       if not Server_Installed (S) then
  345.          Handler_Access (S) := new Handler_Task (S);
  346.       end if;
  347.       --  Invoke a corresponding Handler_Task
  348.  
  349.       User_Handler_Table (S) := Signal_Entry_Assoc' (T => T, E => E);
  350.  
  351.       Unlock (M (S));
  352.  
  353.       Signal_Manager.Bind_Handler (T, E, S);
  354.    end Bind_Signal_To_Entry;
  355.  
  356.    --------------------
  357.    -- Detach_Handler --
  358.    --------------------
  359.  
  360.    procedure Detach_Handler (T : Tasking.Task_ID) is
  361.    begin
  362.       Signal_Manager.Unbind_Handler (T);
  363.    end Detach_Handler;
  364.  
  365.    ------------------
  366.    -- Block_Signal --
  367.    ------------------
  368.  
  369.    procedure Block_Signal (S : RTE.Signal) is
  370.       Ceiling_Violation : boolean;
  371.    begin
  372.       Write_Lock (M (S), Ceiling_Violation);
  373.       if not Is_Blocked_Unprotected (S) then
  374.          Signal_Server_Table (S).Blocked := true;
  375.          if Handler_Installed (S) then
  376.             Signal_Task (Signal_Server_Table (S).Task_ID, S);
  377.          else
  378.             Signal_Manager.Block_Signal (S);
  379.          end if;
  380.       end if;
  381.       Unlock (M (S));
  382.    end Block_Signal;
  383.  
  384.    ---------------------
  385.    -- Unlock_Signal --
  386.    ---------------------
  387.  
  388.    procedure Unblock_Signal (S : RTE.Signal) is
  389.       Ceiling_Violation : boolean;
  390.    begin
  391.       Write_Lock (M (S), Ceiling_Violation);
  392.       if Is_Blocked_Unprotected (S) then
  393.          Signal_Server_Table (S).Blocked := false;
  394.          if Handler_Installed (S) then
  395.             Cond_Signal (C (S));
  396.             --  should make this to wait on sigwait instead cond variable
  397.          else
  398.             Signal_Manager.Unblock_Signal (S);
  399.          end if;
  400.       end if;
  401.       Unlock (M (S));
  402.    end Unblock_Signal;
  403.  
  404.    ----------------
  405.    -- Is_Blocked --
  406.    ----------------
  407.  
  408.    function Is_Blocked (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
  409.       Tmp : boolean;
  410.       Ceiling_Violation : boolean;
  411.    begin
  412.       Write_Lock (M (S), Ceiling_Violation);
  413.       Tmp :=  Signal_Server_Table (S).Blocked;
  414.       Unlock (M (S));
  415.       return Tmp;
  416.    end Is_Blocked;
  417.  
  418.    ----------------
  419.    -- Is_Ignored --
  420.    ----------------
  421.  
  422.    function Is_Ignored (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
  423.       Tmp : boolean;
  424.       Ceiling_Violation : boolean;
  425.    begin
  426.       Write_Lock (M (S), Ceiling_Violation);
  427.       Tmp := Signal_Server_Table (S).Ignored;
  428.       Unlock (M (S));
  429.       return Tmp;
  430.    end Is_Ignored;
  431.  
  432.  
  433.    -------------------
  434.    -- Ignore_Signal --
  435.    -------------------
  436.  
  437.    procedure Ignore_Signal (S : RTE.Signal) is
  438.       Action : aliased RTE.struct_sigaction;
  439.       Oact   : aliased RTE.struct_sigaction;
  440.       Result : Interfaces.C.POSIX_Error.Return_Code;
  441.       Ceiling_Violation : boolean;
  442.    begin
  443.       Write_Lock (M (S), Ceiling_Violation);
  444.       if not Is_Ignored_Unprotected (S) then
  445.          RTE.sigaction (S, Action'Access, Result);
  446.          Action.sa_handler := Storage_Elements.To_Address (RTE.SIG_IGN);
  447.          RTE.sigaction (S, Action'Access, Oact'Access, Result);
  448.          pragma Assert (Result /= Failure or else
  449.            Utilities.Runtime_Assert_Shutdown ("Signals Failure---sigaction"));
  450.          Signal_Server_Table (S).Ignored := true;
  451.       end if;
  452.       Unlock (M (S));
  453.    end Ignore_Signal;
  454.  
  455.    ---------------------
  456.    -- Unignore_Signal --
  457.    ---------------------
  458.  
  459.    procedure Unignore_Signal (S : RTE.Signal) is
  460.       Action : aliased RTE.struct_sigaction;
  461.       Oact   : aliased RTE.struct_sigaction;
  462.       Result : Interfaces.C.POSIX_Error.Return_Code;
  463.       Ceiling_Violation : boolean;
  464.    begin
  465.       Write_Lock (M (S), Ceiling_Violation);
  466.       if Is_Ignored_Unprotected (S) then
  467.          RTE.sigaction (S, Action'Access, Result);
  468.          Action.sa_handler := Storage_Elements.To_Address (RTE.SIG_DFL);
  469.          RTE.sigaction (S, Action'Access, Oact'Access, Result);
  470.          pragma Assert (Result /= Failure or else
  471.            Utilities.Runtime_Assert_Shutdown ("Signals Failure---sigaction"));
  472.          Signal_Server_Table (S).Ignored := false;
  473.       end if;
  474.       Unlock (M (S));
  475.    end Unignore_Signal;
  476.  
  477.    -----------------------
  478.    -- Handler_Installed --
  479.    -----------------------
  480.  
  481.    function Handler_Installed (S : RTE.Signal) return boolean is
  482.    begin
  483.       return User_Handler_Table (S) /= Null_Signal_Entry_Assoc;
  484.    end Handler_Installed;
  485.  
  486.    ----------------------
  487.    -- Server_Installed --
  488.    ----------------------
  489.  
  490.    function Server_Installed (S : RTE.Signal) return boolean is
  491.    begin
  492.       return Signal_Server_Table (S).Task_ID /= Tasking.Null_Task;
  493.    end Server_Installed;
  494.  
  495.    -------------------
  496.    --  Signal_Task  --
  497.    -------------------
  498.  
  499.    procedure Signal_Task (T : Tasking.Task_ID; S : RTE.Signal) is
  500.  
  501.       type ATCB_Ptr is access Tasking.Ada_Task_Control_Block;
  502.  
  503.       function Task_ID_To_ATCB_Ptr is new
  504.         Unchecked_Conversion (Tasking.Task_ID, ATCB_Ptr);
  505.  
  506.       T_Access : Task_Primitives.TCB_Ptr :=
  507.         Task_ID_To_ATCB_Ptr (T).LL_TCB'Unchecked_Access;
  508.       Result : Interfaces.C.POSIX_Error.Return_Code;
  509.    begin
  510.       Interfaces.C.Pthreads.pthread_kill
  511.          (T_Access.Thread, S, Result);
  512.       pragma Assert (Result /= Failure or else
  513.         Utilities.Runtime_Assert_Shutdown ("GNULLI failure---pthread_kill"));
  514.    end Signal_Task;
  515.  
  516.    -------------------------
  517.    -- Thread_Block_Signal --
  518.    -------------------------
  519.  
  520.    procedure Thread_Block_Signal (S : RTE.Signal) is
  521.       Signal_Mask, Old_Set : aliased RTE.Signal_Set;
  522.       Result : Interfaces.C.POSIX_Error.Return_Code;
  523.    begin
  524.       RTE.sigemptyset (Signal_Mask'Access, Result);
  525.       pragma Assert (Result /= Failure or else
  526.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigemptyset"));
  527.       RTE.sigaddset (Signal_Mask'Access, S, Result);
  528.       pragma Assert (Result /= Failure or else
  529.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  530.       RTE.sigprocmask (
  531.         RTE.SIG_BLOCK, Signal_Mask'Access, Old_Set'Access, Result);
  532.       pragma Assert (Result /= Failure or else
  533.         Utilities.Runtime_Assert_Shutdown ("GNULLI failure---sigprocmask"));
  534.    end Thread_Block_Signal;
  535.  
  536.    ---------------------------
  537.    -- Thread_Unblock_Signal --
  538.    ---------------------------
  539.  
  540.    procedure Thread_Unblock_Signal (S : RTE.Signal) is
  541.       Signal_Mask, Old_Set : aliased RTE.Signal_Set;
  542.       Result : Interfaces.C.POSIX_Error.Return_Code;
  543.    begin
  544.       RTE.sigemptyset (Signal_Mask'Access, Result);
  545.       pragma Assert (Result /= Failure or else
  546.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigemptyset"));
  547.       RTE.sigaddset (Signal_Mask'Access, S, Result);
  548.       pragma Assert (Result /= Failure or else
  549.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  550.       RTE.sigprocmask (
  551.         RTE.SIG_UNBLOCK, Signal_Mask'Access, Old_Set'Access, Result);
  552.       pragma Assert (Result /= Failure or else
  553.         Utilities.Runtime_Assert_Shutdown ("GNULLI failure---sigprocmask"));
  554.    end Thread_Unblock_Signal;
  555.  
  556.    -------------------------
  557.    -- Asynchronous_Signal --
  558.    -------------------------
  559.  
  560.    function Asynchronous_Signal (S : RTE.Signal) return boolean is
  561.    begin
  562.       return Signal_Server_Table (S).Asynchronous;
  563.    end Asynchronous_Signal;
  564.  
  565.    -------------------------
  566.    -- Initialize_Blocking --
  567.    -------------------------
  568.  
  569.    procedure Initialize_Blocking is
  570.       Signal_Mask, Old_Set : aliased RTE.Signal_Set;
  571.       Result : Interfaces.C.POSIX_Error.Return_Code;
  572.    begin
  573.       RTE.sigprocmask (RTE.SIG_BLOCK, null, Signal_Mask'Access, Result);
  574.       pragma Assert (Result /= Failure or else
  575.         Utilities.Runtime_Assert_Shutdown ("Signals Failure---sigprocmask"));
  576.       for I in Signal_Index loop
  577.          if RTE.sigismember (Signal_Mask'Access, I) = 1 then
  578.             Signal_Server_Table (I).Blocked := true;
  579.          end if;
  580.       end loop;
  581.    end Initialize_Blocking;
  582.  
  583.    ------------------------
  584.    -- Unmask_All_Signals --
  585.    ------------------------
  586.  
  587.    --  Unmask asynchronous signals for calling thread.
  588.  
  589.    procedure Unmask_All_Signals is
  590.       Signal_Mask, Old_Set : aliased RTE.Signal_Set;
  591.       Result : Interfaces.C.POSIX_Error.Return_Code;
  592.    begin
  593.       RTE.sigemptyset (Signal_Mask'Access, Result);
  594.       pragma Assert (Result /= Failure or else
  595.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigemptyset"));
  596.       --  RTE.sigaddset (Signal_Mask'Access, RTE.SIGABRT, Result);
  597.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGHUP, Result);
  598.       pragma Assert (Result /= Failure or else
  599.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  600.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGINT, Result);
  601.       pragma Assert (Result /= Failure or else
  602.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  603.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGPIPE, Result);
  604.       pragma Assert (Result /= Failure or else
  605.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  606.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGQUIT, Result);
  607.       pragma Assert (Result /= Failure or else
  608.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  609.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGTERM, Result);
  610.       pragma Assert (Result /= Failure or else
  611.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  612.       --  RTE.sigaddset (Signal_Mask'Access, RTE.SIGUSR1, Result);
  613.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGUSR2, Result);
  614.       pragma Assert (Result /= Failure or else
  615.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  616.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGCHLD, Result);
  617.       pragma Assert (Result /= Failure or else
  618.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  619.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGCONT, Result);
  620.       pragma Assert (Result /= Failure or else
  621.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  622.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGTSTP, Result);
  623.       pragma Assert (Result /= Failure or else
  624.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  625.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGTTIN, Result);
  626.       pragma Assert (Result /= Failure or else
  627.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  628.       RTE.sigaddset (Signal_Mask'Access, RTE.SIGTTOU, Result);
  629.       pragma Assert (Result /= Failure or else
  630.         Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  631.  
  632.  
  633.       --  Unmask OS specific Asynchronous signals
  634.  
  635.       for i in RTE.OS_Specific_Async_Signals'First + 1 ..
  636.         RTE.OS_Specific_Async_Signals'Last loop
  637.          RTE.sigaddset
  638.            (Signal_Mask'Access, RTE.OS_Specific_Async_Signals (i), Result);
  639.          pragma Assert (Result /= Failure or else
  640.            Utilities.Runtime_Assert_Shutdown ("Signals failure---sigaddset"));
  641.       end loop;
  642.  
  643.       RTE.sigprocmask (
  644.         RTE.SIG_UNBLOCK, Signal_Mask'Access, Old_Set'Access, Result);
  645.       pragma Assert (Result /= Failure or else
  646.         Utilities.Runtime_Assert_Shutdown ("Signals Failure---sigprocmask"));
  647.    end Unmask_All_Signals;
  648.  
  649.    ----------------------------
  650.    -- Is_Blocked_Unprotected --
  651.    ----------------------------
  652.  
  653.    function Is_Blocked_Unprotected
  654.      (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
  655.    begin
  656.       return Signal_Server_Table (S).Blocked;
  657.    end Is_Blocked_Unprotected;
  658.  
  659.    ----------------------------
  660.    -- Is_Ignored_Unprotected --
  661.    ----------------------------
  662.  
  663.    function Is_Ignored_Unprotected
  664.      (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
  665.    begin
  666.       return Signal_Server_Table (S).Ignored;
  667.    end Is_Ignored_Unprotected;
  668.  
  669.    ------------------------------
  670.    -- Init_Signal_Server_Table --
  671.    ------------------------------
  672.  
  673.    procedure Init_Signal_Server_Table is
  674.    begin
  675.       Signal_Server_Table := Signal_Server_Array'
  676.         (RTE.SIGKILL | RTE.SIGSTOP | RTE.SIGALRM | RTE.SIGILL | RTE.SIGFPE |
  677.          RTE.SIGSEGV |
  678.          RTE.SIGABRT | RTE.SIGUSR1
  679.          --  These two signals are asynchronous signals according to POSIX
  680.          => (Task_ID      => Tasking.Null_Task,
  681.              Blocked      => false,
  682.              Ignored      => false,
  683.              Asynchronous => false),
  684.          others
  685.          => (Task_ID      => Tasking.Null_Task,
  686.              Blocked      => false,
  687.              Ignored      => false,
  688.              Asynchronous => true));
  689.  
  690.       --  Reflect OS specific Synchronous signals
  691.       for i in RTE.OS_Specific_Sync_Signals'First + 1 ..
  692.         RTE.OS_Specific_Sync_Signals'Last loop
  693.          Signal_Server_Table (RTE.OS_Specific_Sync_Signals (i)) :=
  694.             Server_Info' (Task_ID      => Tasking.Null_Task,
  695.                           Blocked      => false,
  696.                           Ignored      => false,
  697.                           Asynchronous => false);
  698.       end loop;
  699.    end Init_Signal_Server_Table;
  700. begin
  701.    Init_Signal_Server_Table;
  702. end System.Signals;
  703.