+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T --
--- --
--- B o d y --
--- --
--- $Revision: 1.1 $
--- --
--- Copyright (C) 1991-2001 Florida State University --
--- --
--- 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNARL; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- 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). --
--- --
-------------------------------------------------------------------------------
-
--- This is the VxWorks version of this package.
-
--- It is likely to need tailoring to fit each operating system
--- and machine architecture.
-
--- PLEASE DO NOT add any dependences on other packages.
--- This package is designed to work with or without tasking support.
-
--- See the other warnings in the package specification before making
--- any modifications to this file.
-
--- Make a careful study of all signals available under the OS,
--- to see which need to be reserved, kept always unmasked,
--- or kept always unmasked.
--- Be on the lookout for special signals that
--- 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);
-
- type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
- Exception_Interrupts : constant Interrupt_List :=
- (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 --
- ----------------------
-
- procedure Notify_Exception (signo : Signal);
- -- Identify the Ada exception to be raised using
- -- the information when the system received a synchronous signal.
-
- procedure Notify_Exception (signo : Signal) is
- Mask : aliased sigset_t;
- Result : Interfaces.C.int;
- My_Id : pthread_t;
- 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;
-
- -- 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;
- when SIGILL =>
- raise Constraint_Error;
- when SIGSEGV =>
- raise Program_Error;
- when SIGBUS =>
- raise Program_Error;
- when others =>
- pragma Assert (Shutdown ("Unexpected signal"));
- null;
- 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 --
- ---------------------------
-
- -- Since there is no signal inheritance between VxWorks tasks, we need
- -- to initialize signal handling in each task.
-
- procedure Initialize_Interrupts is
- 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,
- old_act'Unchecked_Access);
- pragma Assert (Result = 0);
- end loop;
- end Initialize_Interrupts;
-
-begin
- declare
- mask : aliased sigset_t;
- default_mask : aliased sigset_t;
- Result : Interfaces.C.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
-
- 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;
projects / msp430-gcc.git / blobdiff