1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- 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 --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
12 -- GNARL is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. It is --
31 -- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 -- This is the VxWorks version of this package.
37 -- It is likely to need tailoring to fit each operating system
38 -- and machine architecture.
40 -- PLEASE DO NOT add any dependences on other packages.
41 -- This package is designed to work with or without tasking support.
43 -- See the other warnings in the package specification before making
44 -- any modifications to this file.
46 -- Make a careful study of all signals available under the OS,
47 -- to see which need to be reserved, kept always unmasked,
48 -- or kept always unmasked.
49 -- Be on the lookout for special signals that
50 -- may be used by the thread library.
54 with System
.OS_Interface
;
55 -- used for various Constants, Signal and types
57 package body System
.Interrupt_Management
is
59 use System
.OS_Interface
;
60 use type Interfaces
.C
.int
;
62 type Interrupt_List
is array (Interrupt_ID
range <>) of Interrupt_ID
;
63 Exception_Interrupts
: constant Interrupt_List
(1 .. 4) :=
64 (SIGFPE
, SIGILL
, SIGSEGV
, SIGBUS
);
66 -- Keep these variables global so that they are initialized only once.
68 Exception_Action
: aliased struct_sigaction
;
70 ----------------------
71 -- Notify_Exception --
72 ----------------------
74 procedure Notify_Exception
(signo
: Signal
);
75 -- Identify the Ada exception to be raised using
76 -- the information when the system received a synchronous signal.
78 procedure Notify_Exception
(signo
: Signal
) is
79 Mask
: aliased sigset_t
;
84 Result
:= pthread_sigmask
(SIG_SETMASK
, null, Mask
'Unchecked_Access);
85 Result
:= sigdelset
(Mask
'Access, signo
);
86 Result
:= pthread_sigmask
(SIG_SETMASK
, Mask
'Unchecked_Access, null);
88 -- VxWorks will suspend the task when it gets a hardware
89 -- exception. We take the liberty of resuming the task
90 -- for the application.
93 if taskIsSuspended
(My_Id
) /= 0 then
94 Result
:= taskResume
(My_Id
);
99 raise Constraint_Error
;
101 raise Constraint_Error
;
110 end Notify_Exception
;
112 ---------------------------
113 -- Initialize_Interrupts --
114 ---------------------------
116 -- Since there is no signal inheritance between VxWorks tasks, we need
117 -- to initialize signal handling in each task.
119 procedure Initialize_Interrupts
is
121 old_act
: aliased struct_sigaction
;
124 for J
in Exception_Interrupts
'Range loop
127 (Signal
(Exception_Interrupts
(J
)), Exception_Action
'Access,
128 old_act
'Unchecked_Access);
129 pragma Assert
(Result
= 0);
131 end Initialize_Interrupts
;
135 mask
: aliased sigset_t
;
138 Abort_Task_Interrupt
:= SIGABRT
;
139 -- Change this if you want to use another signal for task abort.
140 -- SIGTERM might be a good one.
142 Exception_Action
.sa_handler
:= Notify_Exception
'Address;
143 Exception_Action
.sa_flags
:= SA_ONSTACK
;
144 Result
:= sigemptyset
(mask
'Access);
145 pragma Assert
(Result
= 0);
147 for J
in Exception_Interrupts
'Range loop
148 Result
:= sigaddset
(mask
'Access, Signal
(Exception_Interrupts
(J
)));
149 pragma Assert
(Result
= 0);
152 Exception_Action
.sa_mask
:= mask
;
154 end System
.Interrupt_Management
;