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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-inmaop-vxworks.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-2011, 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 VxWorks version of this package. Many operations are null as this
34
--  package supports the use of Ada interrupt handling facilities for signals,
35
--  while those facilities are used for hardware interrupts on these targets.
36
 
37
with Ada.Exceptions;
38
 
39
with Interfaces.C;
40
 
41
with System.OS_Interface;
42
 
43
package body System.Interrupt_Management.Operations is
44
 
45
   use Ada.Exceptions;
46
   use Interfaces.C;
47
   use System.OS_Interface;
48
 
49
   ----------------------------
50
   -- Thread_Block_Interrupt --
51
   ----------------------------
52
 
53
   procedure Thread_Block_Interrupt
54
     (Interrupt : Interrupt_ID)
55
   is
56
      pragma Unreferenced (Interrupt);
57
   begin
58
      Raise_Exception
59
        (Program_Error'Identity,
60
         "Thread_Block_Interrupt unimplemented");
61
   end Thread_Block_Interrupt;
62
 
63
   ------------------------------
64
   -- Thread_Unblock_Interrupt --
65
   ------------------------------
66
 
67
   procedure Thread_Unblock_Interrupt
68
     (Interrupt : Interrupt_ID)
69
   is
70
      pragma Unreferenced (Interrupt);
71
   begin
72
      Raise_Exception
73
        (Program_Error'Identity,
74
         "Thread_Unblock_Interrupt unimplemented");
75
   end Thread_Unblock_Interrupt;
76
 
77
   ------------------------
78
   -- Set_Interrupt_Mask --
79
   ------------------------
80
 
81
   procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
82
      pragma Unreferenced (Mask);
83
   begin
84
      null;
85
   end Set_Interrupt_Mask;
86
 
87
   procedure Set_Interrupt_Mask
88
     (Mask  : access Interrupt_Mask;
89
      OMask : access Interrupt_Mask)
90
   is
91
      pragma Unreferenced (Mask, OMask);
92
   begin
93
      Raise_Exception
94
        (Program_Error'Identity,
95
         "Set_Interrupt_Mask unimplemented");
96
   end Set_Interrupt_Mask;
97
 
98
   ------------------------
99
   -- Get_Interrupt_Mask --
100
   ------------------------
101
 
102
   procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
103
      pragma Unreferenced (Mask);
104
   begin
105
      Raise_Exception
106
        (Program_Error'Identity,
107
         "Get_Interrupt_Mask unimplemented");
108
   end Get_Interrupt_Mask;
109
 
110
   --------------------
111
   -- Interrupt_Wait --
112
   --------------------
113
 
114
   function Interrupt_Wait
115
     (Mask : access Interrupt_Mask) return Interrupt_ID
116
   is
117
      pragma Unreferenced (Mask);
118
   begin
119
      Raise_Exception
120
        (Program_Error'Identity,
121
         "Interrupt_Wait unimplemented");
122
      return 0;
123
   end Interrupt_Wait;
124
 
125
   ----------------------------
126
   -- Install_Default_Action --
127
   ----------------------------
128
 
129
   procedure Install_Default_Action (Interrupt : Interrupt_ID) is
130
      pragma Unreferenced (Interrupt);
131
   begin
132
      Raise_Exception
133
        (Program_Error'Identity,
134
         "Install_Default_Action unimplemented");
135
   end Install_Default_Action;
136
 
137
   ---------------------------
138
   -- Install_Ignore_Action --
139
   ---------------------------
140
 
141
   procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
142
      pragma Unreferenced (Interrupt);
143
   begin
144
      Raise_Exception
145
        (Program_Error'Identity,
146
         "Install_Ignore_Action unimplemented");
147
   end Install_Ignore_Action;
148
 
149
   -------------------------
150
   -- Fill_Interrupt_Mask --
151
   -------------------------
152
 
153
   procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
154
      pragma Unreferenced (Mask);
155
   begin
156
      Raise_Exception
157
        (Program_Error'Identity,
158
         "Fill_Interrupt_Mask unimplemented");
159
   end Fill_Interrupt_Mask;
160
 
161
   --------------------------
162
   -- Empty_Interrupt_Mask --
163
   --------------------------
164
 
165
   procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
166
      pragma Unreferenced (Mask);
167
   begin
168
      Raise_Exception
169
        (Program_Error'Identity,
170
         "Empty_Interrupt_Mask unimplemented");
171
   end Empty_Interrupt_Mask;
172
 
173
   ---------------------------
174
   -- Add_To_Interrupt_Mask --
175
   ---------------------------
176
 
177
   procedure Add_To_Interrupt_Mask
178
     (Mask      : access Interrupt_Mask;
179
      Interrupt : Interrupt_ID)
180
   is
181
      pragma Unreferenced (Mask, Interrupt);
182
   begin
183
      Raise_Exception
184
        (Program_Error'Identity,
185
         "Add_To_Interrupt_Mask unimplemented");
186
   end Add_To_Interrupt_Mask;
187
 
188
   --------------------------------
189
   -- Delete_From_Interrupt_Mask --
190
   --------------------------------
191
 
192
   procedure Delete_From_Interrupt_Mask
193
     (Mask      : access Interrupt_Mask;
194
      Interrupt : Interrupt_ID)
195
   is
196
      pragma Unreferenced (Mask, Interrupt);
197
   begin
198
      Raise_Exception
199
        (Program_Error'Identity,
200
         "Delete_From_Interrupt_Mask unimplemented");
201
   end Delete_From_Interrupt_Mask;
202
 
203
   ---------------
204
   -- Is_Member --
205
   ---------------
206
 
207
   function Is_Member
208
     (Mask      : access Interrupt_Mask;
209
      Interrupt : Interrupt_ID) return Boolean
210
   is
211
      pragma Unreferenced (Mask, Interrupt);
212
   begin
213
      Raise_Exception
214
        (Program_Error'Identity,
215
         "Is_Member unimplemented");
216
      return False;
217
   end Is_Member;
218
 
219
   -------------------------
220
   -- Copy_Interrupt_Mask --
221
   -------------------------
222
 
223
   procedure Copy_Interrupt_Mask
224
     (X : out Interrupt_Mask;
225
      Y : Interrupt_Mask) is
226
      pragma Unreferenced (X, Y);
227
   begin
228
      Raise_Exception
229
        (Program_Error'Identity,
230
         "Copy_Interrupt_Mask unimplemented");
231
   end Copy_Interrupt_Mask;
232
 
233
   ----------------------------
234
   -- Interrupt_Self_Process --
235
   ----------------------------
236
 
237
   procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
238
      Result : Interfaces.C.int;
239
   begin
240
      Result := kill (getpid, Signal (Interrupt));
241
      pragma Assert (Result = 0);
242
   end Interrupt_Self_Process;
243
 
244
   --------------------------
245
   -- Setup_Interrupt_Mask --
246
   --------------------------
247
 
248
   procedure Setup_Interrupt_Mask is
249
   begin
250
      --  Nothing to be done. Ada interrupt facilities on VxWorks do not use
251
      --  signals but hardware interrupts. Therefore, interrupt management does
252
      --  not need anything related to signal masking. Note that this procedure
253
      --  cannot raise an exception (as some others in this package) because
254
      --  the generic implementation of the Timer_Server and timing events make
255
      --  explicit calls to this routine to make ensure proper signal masking
256
      --  on targets needed that.
257
 
258
      null;
259
   end Setup_Interrupt_Mask;
260
 
261
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.