with Interfaces.C;
with System.OS_Interface;
with System.Storage_Elements;
with Unchecked_Conversion;
package body System.Interrupt_Management.Operations is
use Interfaces.C;
use System.OS_Interface;
type Interrupt_Mask_Ptr is access all Interrupt_Mask;
function "+" is new
Unchecked_Conversion (Interrupt_Mask_Ptr, sigset_t_ptr);
Initial_Action : array (Signal) of aliased struct_sigaction;
Default_Action : aliased struct_sigaction;
Ignore_Action : aliased struct_sigaction;
procedure Thread_Block_Interrupt
(Interrupt : Interrupt_ID)
is
Result : Interfaces.C.int;
Mask : aliased sigset_t;
begin
Result := sigemptyset (Mask'Access);
pragma Assert (Result = 0);
Result := sigaddset (Mask'Access, Signal (Interrupt));
pragma Assert (Result = 0);
Result := pthread_sigmask (SIG_BLOCK, Mask'Unchecked_Access, null);
pragma Assert (Result = 0);
end Thread_Block_Interrupt;
procedure Thread_Unblock_Interrupt
(Interrupt : Interrupt_ID)
is
Mask : aliased sigset_t;
Result : Interfaces.C.int;
begin
Result := sigemptyset (Mask'Access);
pragma Assert (Result = 0);
Result := sigaddset (Mask'Access, Signal (Interrupt));
pragma Assert (Result = 0);
Result := pthread_sigmask (SIG_UNBLOCK, Mask'Unchecked_Access, null);
pragma Assert (Result = 0);
end Thread_Unblock_Interrupt;
procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
Result : Interfaces.C.int;
begin
Result := pthread_sigmask
(SIG_SETMASK, +Interrupt_Mask_Ptr (Mask), null);
pragma Assert (Result = 0);
end Set_Interrupt_Mask;
procedure Set_Interrupt_Mask
(Mask : access Interrupt_Mask;
OMask : access Interrupt_Mask)
is
Result : Interfaces.C.int;
begin
Result := pthread_sigmask
(SIG_SETMASK, +Interrupt_Mask_Ptr (Mask), +Interrupt_Mask_Ptr (OMask));
pragma Assert (Result = 0);
end Set_Interrupt_Mask;
procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
Result : Interfaces.C.int;
begin
Result := pthread_sigmask
(SIG_SETMASK, null, +Interrupt_Mask_Ptr (Mask));
pragma Assert (Result = 0);
end Get_Interrupt_Mask;
function Interrupt_Wait
(Mask : access Interrupt_Mask)
return Interrupt_ID
is
Result : Interfaces.C.int;
Sig : aliased Signal;
begin
Result := sigwait (Mask, Sig'Access);
if Result /= 0 then
return 0;
end if;
return Interrupt_ID (Sig);
end Interrupt_Wait;
procedure Install_Default_Action (Interrupt : Interrupt_ID) is
Result : Interfaces.C.int;
begin
Result := sigaction
(Signal (Interrupt),
Initial_Action (Signal (Interrupt))'Access, null);
pragma Assert (Result = 0);
end Install_Default_Action;
procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
Result : Interfaces.C.int;
begin
Result := sigaction (Signal (Interrupt), Ignore_Action'Access, null);
pragma Assert (Result = 0);
end Install_Ignore_Action;
procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
Result : Interfaces.C.int;
begin
Result := sigfillset (Mask);
pragma Assert (Result = 0);
end Fill_Interrupt_Mask;
procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
Result : Interfaces.C.int;
begin
Result := sigemptyset (Mask);
pragma Assert (Result = 0);
end Empty_Interrupt_Mask;
procedure Add_To_Interrupt_Mask
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID)
is
Result : Interfaces.C.int;
begin
Result := sigaddset (Mask, Signal (Interrupt));
pragma Assert (Result = 0);
end Add_To_Interrupt_Mask;
procedure Delete_From_Interrupt_Mask
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID)
is
Result : Interfaces.C.int;
begin
Result := sigdelset (Mask, Signal (Interrupt));
pragma Assert (Result = 0);
end Delete_From_Interrupt_Mask;
function Is_Member
(Mask : access Interrupt_Mask;
Interrupt : Interrupt_ID) return Boolean
is
Result : Interfaces.C.int;
begin
Result := sigismember (Mask, Signal (Interrupt));
pragma Assert (Result = 0 or else Result = 1);
return Result = 1;
end Is_Member;
procedure Copy_Interrupt_Mask
(X : out Interrupt_Mask;
Y : Interrupt_Mask)
is
begin
X := Y;
end Copy_Interrupt_Mask;
procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
Result : Interfaces.C.int;
begin
Result := kill (getpid, Signal (Interrupt));
pragma Assert (Result = 0);
end Interrupt_Self_Process;
begin
declare
mask : aliased sigset_t;
allmask : aliased sigset_t;
Result : Interfaces.C.int;
begin
for Sig in 1 .. Signal'Last loop
Result := sigaction
(Sig, null, Initial_Action (Sig)'Unchecked_Access);
end loop;
Result := sigemptyset (mask'Access);
pragma Assert (Result = 0);
Result := sigfillset (allmask'Access);
pragma Assert (Result = 0);
Default_Action.sa_flags := 0;
Default_Action.sa_mask := mask;
Default_Action.sa_handler :=
Storage_Elements.To_Address
(Storage_Elements.Integer_Address (SIG_DFL));
Ignore_Action.sa_flags := 0;
Ignore_Action.sa_mask := mask;
Ignore_Action.sa_handler :=
Storage_Elements.To_Address
(Storage_Elements.Integer_Address (SIG_IGN));
for I in Interrupt_ID loop
if Keep_Unmasked (I) then
Result := sigaddset (mask'Access, Signal (I));
pragma Assert (Result = 0);
Result := sigdelset (allmask'Access, Signal (I));
pragma Assert (Result = 0);
end if;
end loop;
Result := pthread_sigmask (SIG_UNBLOCK, mask'Unchecked_Access, null);
pragma Assert (Result = 0);
Result := pthread_sigmask (SIG_SETMASK, null, mask'Unchecked_Access);
pragma Assert (Result = 0);
Environment_Mask := Interrupt_Mask (mask);
All_Tasks_Mask := Interrupt_Mask (allmask);
end;
end System.Interrupt_Management.Operations;