diff options
Diffstat (limited to 'gcc/ada/5zintman.adb')
| -rw-r--r-- | gcc/ada/5zintman.adb | 170 |
1 files changed, 15 insertions, 155 deletions
diff --git a/gcc/ada/5zintman.adb b/gcc/ada/5zintman.adb index 2f58cc2..d49da4d 100644 --- a/gcc/ada/5zintman.adb +++ b/gcc/ada/5zintman.adb @@ -6,9 +6,9 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.11 $ +-- $Revision$ -- -- --- Copyright (C) 1991-2001 Florida State University -- +-- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,8 +29,7 @@ -- covered by the GNU Public License. -- -- -- -- GNARL was developed by the GNARL team at Florida State University. It is -- --- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- --- State University (http://www.gnat.com). -- +-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ @@ -52,42 +51,22 @@ -- may be used by the thread library. with Interfaces.C; --- used for int and other types - -with System.Error_Reporting; -pragma Warnings (Off, System.Error_Reporting); --- used for Shutdown with System.OS_Interface; -- used for various Constants, Signal and types -with Unchecked_Conversion; - package body System.Interrupt_Management is - use Interfaces.C; - use System.Error_Reporting; use System.OS_Interface; - - function To_Isr is new Unchecked_Conversion (Long_Integer, isr_address); + use type Interfaces.C.int; type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; - Exception_Interrupts : constant Interrupt_List := + Exception_Interrupts : constant Interrupt_List (1 .. 4) := (SIGFPE, SIGILL, SIGSEGV, SIGBUS); -- Keep these variables global so that they are initialized only once. Exception_Action : aliased struct_sigaction; - Default_Action : aliased struct_sigaction; - - -- ????? Use these horrible imports here to solve elaboration order - -- problems. - - type Task_Id is access all Integer; - - Interrupt_ID_Map : array (Interrupt_ID) of Task_Id; - pragma Import (Ada, Interrupt_ID_Map, - "system__task_primitives__interrupt_operations__interrupt_id_map"); ---------------------- -- Notify_Exception -- @@ -99,13 +78,10 @@ package body System.Interrupt_Management is procedure Notify_Exception (signo : Signal) is Mask : aliased sigset_t; - Result : Interfaces.C.int; - My_Id : pthread_t; + Result : int; + My_Id : t_id; + begin - -- VxWorks will always mask out the signal during the signal - -- handler and will reenable it on a longjmp. GNAT does - -- not generate a longjmp to return from a signal handler - -- so the signal will still be masked unless we unmask it. Result := pthread_sigmask (SIG_SETMASK, null, Mask'Unchecked_Access); Result := sigdelset (Mask'Access, signo); Result := pthread_sigmask (SIG_SETMASK, Mask'Unchecked_Access, null); @@ -114,26 +90,11 @@ package body System.Interrupt_Management is -- exception. We take the liberty of resuming the task -- for the application. My_Id := taskIdSelf; + if taskIsSuspended (My_Id) /= 0 then Result := taskResume (My_Id); end if; - -- As long as we are using a longjmp to return control to the - -- exception handler on the runtime stack, we are safe. The original - -- signal mask (the one we had before coming into this signal catching - -- function) will be restored by the longjmp. Therefore, raising - -- an exception in this handler should be a safe operation. - - -- Check that treatment of exception propagation here - -- is consistent with treatment of the abort signal in - -- System.Task_Primitives.Operations. - - -- How can SIGSEGV be split into constraint and storage errors? - -- What should SIGILL really raise ? Some implementations have - -- codes for different types of SIGILL and some raise Storage_Error. - -- What causes SIGBUS and should it be caught? - -- Peter Burwood - case signo is when SIGFPE => raise Constraint_Error; @@ -144,63 +105,11 @@ package body System.Interrupt_Management is when SIGBUS => raise Program_Error; when others => - pragma Assert (Shutdown ("Unexpected signal")); - null; + -- Unexpected signal + raise Program_Error; end case; end Notify_Exception; - ------------------- - -- Notify_Signal -- - ------------------- - - -- VxWorks needs a special casing here. Each VxWorks task has a completely - -- separate signal handling, so the usual signal masking can't work. - -- This idea is to handle all the signals in all the tasks, and when - -- such a signal occurs, redirect it to the dedicated task (if any) or - -- reraise it. - - procedure Notify_Signal (signo : Signal); - - procedure Notify_Signal (signo : Signal) is - Mask : aliased sigset_t; - Result : Interfaces.C.int; - My_Id : pthread_t; - old_isr : isr_address; - - function Get_Thread_Id (T : Task_Id) return pthread_t; - pragma Import (Ada, Get_Thread_Id, - "system__task_primitives__operations__get_thread_id"); - - begin - -- VxWorks will always mask out the signal during the signal - -- handler and will reenable it on a longjmp. GNAT does - -- not generate a longjmp to return from a signal handler - -- so the signal will still be masked unless we unmask it. - Result := pthread_sigmask (SIG_SETMASK, null, Mask'Unchecked_Access); - Result := sigdelset (Mask'Access, signo); - Result := pthread_sigmask (SIG_SETMASK, Mask'Unchecked_Access, null); - - -- VxWorks will suspend the task when it gets a hardware - -- exception. We take the liberty of resuming the task - -- for the application. - My_Id := taskIdSelf; - if taskIsSuspended (My_Id) /= 0 then - Result := taskResume (My_Id); - end if; - - -- ??? Need a lock around this, in case the handler is detached - -- between the two following statements. - - if Interrupt_ID_Map (Interrupt_ID (signo)) /= null then - Result := - kill (Get_Thread_Id (Interrupt_ID_Map (Interrupt_ID (signo))), - Signal (signo)); - else - old_isr := c_signal (signo, To_Isr (SIG_DFL)); - Result := kill (My_Id, Signal (signo)); - end if; - end Notify_Signal; - --------------------------- -- Initialize_Interrupts -- --------------------------- @@ -209,20 +118,11 @@ package body System.Interrupt_Management is -- to initialize signal handling in each task. procedure Initialize_Interrupts is + Result : int; old_act : aliased struct_sigaction; - Result : Interfaces.C.int; begin - for J in Interrupt_ID'First + 1 .. Interrupt_ID'Last loop - if J /= Abort_Task_Interrupt then - Result := sigaction (Signal (J), Default_Action'Access, - old_act'Unchecked_Access); - pragma Assert (Result = 0); - end if; - end loop; - for J in Exception_Interrupts'Range loop - Keep_Unmasked (Exception_Interrupts (J)) := True; Result := sigaction (Signal (Exception_Interrupts (J)), Exception_Action'Access, @@ -233,63 +133,23 @@ package body System.Interrupt_Management is begin declare - mask : aliased sigset_t; - default_mask : aliased sigset_t; - Result : Interfaces.C.int; - + mask : aliased sigset_t; + Result : int; begin - -- The VxWorks POSIX threads library currently needs initialization. - -- We wish it could be in System.OS_Interface, but that would - -- cause an elaboration problem. - - pthread_init; - Abort_Task_Interrupt := SIGABRT; -- Change this if you want to use another signal for task abort. -- SIGTERM might be a good one. Exception_Action.sa_handler := Notify_Exception'Address; - Default_Action.sa_handler := Notify_Signal'Address; - - Exception_Action.sa_flags := SA_SIGINFO + SA_ONSTACK; - Default_Action.sa_flags := SA_SIGINFO + SA_ONSTACK; - -- Send us extra signal information (SA_SIGINFO) on the - -- stack (SA_ONSTACK). - -- There is no SA_NODEFER in VxWorks. The signal mask is - -- restored after a longjmp so the SA_NODEFER option is - -- not needed. - Dan Eischen - + Exception_Action.sa_flags := SA_ONSTACK; Result := sigemptyset (mask'Access); pragma Assert (Result = 0); - Result := sigemptyset (default_mask'Access); - pragma Assert (Result = 0); - - for J in Interrupt_ID'First + 1 .. Interrupt_ID'Last loop - Result := sigaddset (default_mask'Access, Signal (J)); - pragma Assert (Result = 0); - end loop; for J in Exception_Interrupts'Range loop Result := sigaddset (mask'Access, Signal (Exception_Interrupts (J))); pragma Assert (Result = 0); - Result := - sigdelset (default_mask'Access, Signal (Exception_Interrupts (J))); - pragma Assert (Result = 0); end loop; Exception_Action.sa_mask := mask; - Default_Action.sa_mask := default_mask; - - -- Initialize_Interrupts is called for each task in Enter_Task - - Keep_Unmasked (Abort_Task_Interrupt) := True; - - Reserve := Reserve or Keep_Unmasked or Keep_Masked; - - Reserve (0) := True; - -- We do not have Signal 0 in reality. We just use this value - -- to identify non-existent signals (see s-intnam.ads). Therefore, - -- Signal 0 should not be used in all signal related operations hence - -- mark it as reserved. end; end System.Interrupt_Management; |