OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-inmaop-posix.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
4
--                                                                          --
5
--                  SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                  --
6
--                                                                          --
7
--                                  B o d y                                 --
8
--                                                                          --
9
--             Copyright (C) 1991-1994, Florida State University            --
10
--                     Copyright (C) 1995-2010, AdaCore                     --
11
--                                                                          --
12
-- GNAT 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 3,  or (at your option) any later ver- --
15
-- sion.  GNAT 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.                                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
-- GNARL was developed by the GNARL team at Florida State University.       --
29
-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
30
--                                                                          --
31
------------------------------------------------------------------------------
32
 
33
--  This is a POSIX-like version of this package
34
 
35
--  Note: this file can only be used for POSIX compliant systems
36
 
37
with Interfaces.C;
38
 
39
with System.OS_Interface;
40
with System.Storage_Elements;
41
 
42
package body System.Interrupt_Management.Operations is
43
 
44
   use Interfaces.C;
45
   use System.OS_Interface;
46
 
47
   ---------------------
48
   -- Local Variables --
49
   ---------------------
50
 
51
   Initial_Action : array (Signal) of aliased struct_sigaction;
52
 
53
   Default_Action : aliased struct_sigaction;
54
   pragma Warnings (Off, Default_Action);
55
 
56
   Ignore_Action : aliased struct_sigaction;
57
 
58
   ----------------------------
59
   -- Thread_Block_Interrupt --
60
   ----------------------------
61
 
62
   procedure Thread_Block_Interrupt
63
     (Interrupt : Interrupt_ID)
64
   is
65
      Result : Interfaces.C.int;
66
      Mask   : aliased sigset_t;
67
   begin
68
      Result := sigemptyset (Mask'Access);
69
      pragma Assert (Result = 0);
70
      Result := sigaddset (Mask'Access, Signal (Interrupt));
71
      pragma Assert (Result = 0);
72
      Result := pthread_sigmask (SIG_BLOCK, Mask'Access, null);
73
      pragma Assert (Result = 0);
74
   end Thread_Block_Interrupt;
75
 
76
   ------------------------------
77
   -- Thread_Unblock_Interrupt --
78
   ------------------------------
79
 
80
   procedure Thread_Unblock_Interrupt
81
     (Interrupt : Interrupt_ID)
82
   is
83
      Mask   : aliased sigset_t;
84
      Result : Interfaces.C.int;
85
   begin
86
      Result := sigemptyset (Mask'Access);
87
      pragma Assert (Result = 0);
88
      Result := sigaddset (Mask'Access, Signal (Interrupt));
89
      pragma Assert (Result = 0);
90
      Result := pthread_sigmask (SIG_UNBLOCK, Mask'Access, null);
91
      pragma Assert (Result = 0);
92
   end Thread_Unblock_Interrupt;
93
 
94
   ------------------------
95
   -- Set_Interrupt_Mask --
96
   ------------------------
97
 
98
   procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
99
      Result : Interfaces.C.int;
100
   begin
101
      Result := pthread_sigmask (SIG_SETMASK, Mask, null);
102
      pragma Assert (Result = 0);
103
   end Set_Interrupt_Mask;
104
 
105
   procedure Set_Interrupt_Mask
106
     (Mask  : access Interrupt_Mask;
107
      OMask : access Interrupt_Mask)
108
   is
109
      Result  : Interfaces.C.int;
110
   begin
111
      Result := pthread_sigmask (SIG_SETMASK, Mask, OMask);
112
      pragma Assert (Result = 0);
113
   end Set_Interrupt_Mask;
114
 
115
   ------------------------
116
   -- Get_Interrupt_Mask --
117
   ------------------------
118
 
119
   procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
120
      Result : Interfaces.C.int;
121
   begin
122
      Result := pthread_sigmask (SIG_SETMASK, null, Mask);
123
      pragma Assert (Result = 0);
124
   end Get_Interrupt_Mask;
125
 
126
   --------------------
127
   -- Interrupt_Wait --
128
   --------------------
129
 
130
   function Interrupt_Wait
131
     (Mask : access Interrupt_Mask) return Interrupt_ID
132
   is
133
      Result : Interfaces.C.int;
134
      Sig    : aliased Signal;
135
 
136
   begin
137
      Result := sigwait (Mask, Sig'Access);
138
 
139
      if Result /= 0 then
140
         return 0;
141
      end if;
142
 
143
      return Interrupt_ID (Sig);
144
   end Interrupt_Wait;
145
 
146
   ----------------------------
147
   -- Install_Default_Action --
148
   ----------------------------
149
 
150
   procedure Install_Default_Action (Interrupt : Interrupt_ID) is
151
      Result : Interfaces.C.int;
152
   begin
153
      Result := sigaction
154
        (Signal (Interrupt),
155
         Initial_Action (Signal (Interrupt))'Access, null);
156
      pragma Assert (Result = 0);
157
   end Install_Default_Action;
158
 
159
   ---------------------------
160
   -- Install_Ignore_Action --
161
   ---------------------------
162
 
163
   procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
164
      Result : Interfaces.C.int;
165
   begin
166
      Result := sigaction (Signal (Interrupt), Ignore_Action'Access, null);
167
      pragma Assert (Result = 0);
168
   end Install_Ignore_Action;
169
 
170
   -------------------------
171
   -- Fill_Interrupt_Mask --
172
   -------------------------
173
 
174
   procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
175
      Result : Interfaces.C.int;
176
   begin
177
      Result := sigfillset (Mask);
178
      pragma Assert (Result = 0);
179
   end Fill_Interrupt_Mask;
180
 
181
   --------------------------
182
   -- Empty_Interrupt_Mask --
183
   --------------------------
184
 
185
   procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
186
      Result : Interfaces.C.int;
187
   begin
188
      Result := sigemptyset (Mask);
189
      pragma Assert (Result = 0);
190
   end Empty_Interrupt_Mask;
191
 
192
   ---------------------------
193
   -- Add_To_Interrupt_Mask --
194
   ---------------------------
195
 
196
   procedure Add_To_Interrupt_Mask
197
     (Mask      : access Interrupt_Mask;
198
      Interrupt : Interrupt_ID)
199
   is
200
      Result : Interfaces.C.int;
201
   begin
202
      Result := sigaddset (Mask, Signal (Interrupt));
203
      pragma Assert (Result = 0);
204
   end Add_To_Interrupt_Mask;
205
 
206
   --------------------------------
207
   -- Delete_From_Interrupt_Mask --
208
   --------------------------------
209
 
210
   procedure Delete_From_Interrupt_Mask
211
     (Mask      : access Interrupt_Mask;
212
      Interrupt : Interrupt_ID)
213
   is
214
      Result : Interfaces.C.int;
215
   begin
216
      Result := sigdelset (Mask, Signal (Interrupt));
217
      pragma Assert (Result = 0);
218
   end Delete_From_Interrupt_Mask;
219
 
220
   ---------------
221
   -- Is_Member --
222
   ---------------
223
 
224
   function Is_Member
225
     (Mask      : access Interrupt_Mask;
226
      Interrupt : Interrupt_ID) return Boolean
227
   is
228
      Result : Interfaces.C.int;
229
   begin
230
      Result := sigismember (Mask, Signal (Interrupt));
231
      pragma Assert (Result = 0 or else Result = 1);
232
      return Result = 1;
233
   end Is_Member;
234
 
235
   -------------------------
236
   -- Copy_Interrupt_Mask --
237
   -------------------------
238
 
239
   procedure Copy_Interrupt_Mask
240
     (X : out Interrupt_Mask;
241
      Y : Interrupt_Mask) is
242
   begin
243
      X := Y;
244
   end Copy_Interrupt_Mask;
245
 
246
   ----------------------------
247
   -- Interrupt_Self_Process --
248
   ----------------------------
249
 
250
   procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
251
      Result : Interfaces.C.int;
252
   begin
253
      Result := kill (getpid, Signal (Interrupt));
254
      pragma Assert (Result = 0);
255
   end Interrupt_Self_Process;
256
 
257
   --------------------------
258
   -- Setup_Interrupt_Mask --
259
   --------------------------
260
 
261
   procedure Setup_Interrupt_Mask is
262
   begin
263
      --  Mask task for all signals. The original mask of the Environment task
264
      --  will be recovered by Interrupt_Manager task during the elaboration
265
      --  of s-interr.adb.
266
 
267
      Set_Interrupt_Mask (All_Tasks_Mask'Access);
268
   end Setup_Interrupt_Mask;
269
 
270
begin
271
   declare
272
      mask    : aliased sigset_t;
273
      allmask : aliased sigset_t;
274
      Result  : Interfaces.C.int;
275
 
276
   begin
277
      Interrupt_Management.Initialize;
278
 
279
      for Sig in 1 .. Signal'Last loop
280
         Result := sigaction
281
           (Sig, null, Initial_Action (Sig)'Access);
282
 
283
         --  ??? [assert 1]
284
         --  we can't check Result here since sigaction will fail on
285
         --  SIGKILL, SIGSTOP, and possibly other signals
286
         --  pragma Assert (Result = 0);
287
 
288
      end loop;
289
 
290
      --  Setup the masks to be exported
291
 
292
      Result := sigemptyset (mask'Access);
293
      pragma Assert (Result = 0);
294
 
295
      Result := sigfillset (allmask'Access);
296
      pragma Assert (Result = 0);
297
 
298
      Default_Action.sa_flags   := 0;
299
      Default_Action.sa_mask    := mask;
300
      Default_Action.sa_handler :=
301
        Storage_Elements.To_Address
302
          (Storage_Elements.Integer_Address (SIG_DFL));
303
 
304
      Ignore_Action.sa_flags   := 0;
305
      Ignore_Action.sa_mask    := mask;
306
      Ignore_Action.sa_handler :=
307
        Storage_Elements.To_Address
308
          (Storage_Elements.Integer_Address (SIG_IGN));
309
 
310
      for J in Interrupt_ID loop
311
         if Keep_Unmasked (J) then
312
            Result := sigaddset (mask'Access, Signal (J));
313
            pragma Assert (Result = 0);
314
            Result := sigdelset (allmask'Access, Signal (J));
315
            pragma Assert (Result = 0);
316
         end if;
317
      end loop;
318
 
319
      --  The Keep_Unmasked signals should be unmasked for Environment task
320
 
321
      Result := pthread_sigmask (SIG_UNBLOCK, mask'Access, null);
322
      pragma Assert (Result = 0);
323
 
324
      --  Get the signal mask of the Environment Task
325
 
326
      Result := pthread_sigmask (SIG_SETMASK, null, mask'Access);
327
      pragma Assert (Result = 0);
328
 
329
      --  Setup the constants exported
330
 
331
      Environment_Mask := Interrupt_Mask (mask);
332
 
333
      All_Tasks_Mask := Interrupt_Mask (allmask);
334
   end;
335
 
336
end System.Interrupt_Management.Operations;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.