home *** CD-ROM | disk | FTP | other *** search
- ------------------------------------------------------------------------------
- -- --
- -- 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;
-