X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2F5zintman.adb;fp=gcc%2Fada%2F5zintman.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=affc8ca19be764f72fc1abac26eeb27d63658591;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/5zintman.adb b/gcc/ada/5zintman.adb deleted file mode 100644 index affc8ca1..00000000 --- a/gcc/ada/5zintman.adb +++ /dev/null @@ -1,295 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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;