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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [s-soflin.adb] - Blame information for rev 281

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                    S Y S T E M . S O F T _ L I N K S                     --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
pragma Compiler_Unit;
33
 
34
pragma Polling (Off);
35
--  We must turn polling off for this unit, because otherwise we get an
36
--  infinite loop from the code within the Poll routine itself.
37
 
38
with System.Parameters;
39
 
40
pragma Warnings (Off);
41
--  Disable warnings since System.Secondary_Stack is currently not Preelaborate
42
with System.Secondary_Stack;
43
pragma Warnings (On);
44
 
45
package body System.Soft_Links is
46
 
47
   package SST renames System.Secondary_Stack;
48
 
49
   NT_Exc_Stack : array (0 .. 8192) of aliased Character;
50
   for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
51
   --  Allocate an exception stack for the main program to use.
52
   --  This is currently only used under VMS.
53
 
54
   NT_TSD : TSD;
55
   --  Note: we rely on the default initialization of NT_TSD
56
 
57
   --------------------
58
   -- Abort_Defer_NT --
59
   --------------------
60
 
61
   procedure Abort_Defer_NT is
62
   begin
63
      null;
64
   end Abort_Defer_NT;
65
 
66
   ----------------------
67
   -- Abort_Handler_NT --
68
   ----------------------
69
 
70
   procedure Abort_Handler_NT is
71
   begin
72
      null;
73
   end Abort_Handler_NT;
74
 
75
   ----------------------
76
   -- Abort_Undefer_NT --
77
   ----------------------
78
 
79
   procedure Abort_Undefer_NT is
80
   begin
81
      null;
82
   end Abort_Undefer_NT;
83
 
84
   -----------------
85
   -- Adafinal_NT --
86
   -----------------
87
 
88
   procedure Adafinal_NT is
89
   begin
90
      --  Handle normal task termination by the environment task, but only
91
      --  for the normal task termination. In the case of Abnormal and
92
      --  Unhandled_Exception they must have been handled before, and the
93
      --  task termination soft link must have been changed so the task
94
      --  termination routine is not executed twice.
95
 
96
      Task_Termination_Handler.all (Ada.Exceptions.Null_Occurrence);
97
 
98
      --  Finalize the global list for controlled objects if needed
99
 
100
      Finalize_Global_List.all;
101
   end Adafinal_NT;
102
 
103
   ---------------------------
104
   -- Check_Abort_Status_NT --
105
   ---------------------------
106
 
107
   function Check_Abort_Status_NT return Integer is
108
   begin
109
      return Boolean'Pos (False);
110
   end Check_Abort_Status_NT;
111
 
112
   ------------------------
113
   -- Complete_Master_NT --
114
   ------------------------
115
 
116
   procedure Complete_Master_NT is
117
   begin
118
      null;
119
   end Complete_Master_NT;
120
 
121
   ----------------
122
   -- Create_TSD --
123
   ----------------
124
 
125
   procedure Create_TSD (New_TSD : in out TSD) is
126
      use type Parameters.Size_Type;
127
 
128
      SS_Ratio_Dynamic : constant Boolean :=
129
                           Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
130
 
131
   begin
132
      if SS_Ratio_Dynamic then
133
         SST.SS_Init
134
           (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
135
      end if;
136
   end Create_TSD;
137
 
138
   -----------------------
139
   -- Current_Master_NT --
140
   -----------------------
141
 
142
   function Current_Master_NT return Integer is
143
   begin
144
      return 0;
145
   end Current_Master_NT;
146
 
147
   -----------------
148
   -- Destroy_TSD --
149
   -----------------
150
 
151
   procedure Destroy_TSD (Old_TSD : in out TSD) is
152
   begin
153
      SST.SS_Free (Old_TSD.Sec_Stack_Addr);
154
   end Destroy_TSD;
155
 
156
   ---------------------
157
   -- Enter_Master_NT --
158
   ---------------------
159
 
160
   procedure Enter_Master_NT is
161
   begin
162
      null;
163
   end Enter_Master_NT;
164
 
165
   --------------------------
166
   -- Get_Current_Excep_NT --
167
   --------------------------
168
 
169
   function Get_Current_Excep_NT return EOA is
170
   begin
171
      return NT_TSD.Current_Excep'Access;
172
   end Get_Current_Excep_NT;
173
 
174
   ---------------------------
175
   -- Get_Exc_Stack_Addr_NT --
176
   ---------------------------
177
 
178
   function Get_Exc_Stack_Addr_NT return Address is
179
   begin
180
      return NT_Exc_Stack (NT_Exc_Stack'Last)'Address;
181
   end Get_Exc_Stack_Addr_NT;
182
 
183
   -----------------------------
184
   -- Get_Exc_Stack_Addr_Soft --
185
   -----------------------------
186
 
187
   function Get_Exc_Stack_Addr_Soft return Address is
188
   begin
189
      return Get_Exc_Stack_Addr.all;
190
   end Get_Exc_Stack_Addr_Soft;
191
 
192
   ------------------------
193
   -- Get_GNAT_Exception --
194
   ------------------------
195
 
196
   function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is
197
   begin
198
      return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all);
199
   end Get_GNAT_Exception;
200
 
201
   ---------------------------
202
   -- Get_Jmpbuf_Address_NT --
203
   ---------------------------
204
 
205
   function Get_Jmpbuf_Address_NT return  Address is
206
   begin
207
      return NT_TSD.Jmpbuf_Address;
208
   end Get_Jmpbuf_Address_NT;
209
 
210
   -----------------------------
211
   -- Get_Jmpbuf_Address_Soft --
212
   -----------------------------
213
 
214
   function Get_Jmpbuf_Address_Soft return  Address is
215
   begin
216
      return Get_Jmpbuf_Address.all;
217
   end Get_Jmpbuf_Address_Soft;
218
 
219
   ---------------------------
220
   -- Get_Sec_Stack_Addr_NT --
221
   ---------------------------
222
 
223
   function Get_Sec_Stack_Addr_NT return  Address is
224
   begin
225
      return NT_TSD.Sec_Stack_Addr;
226
   end Get_Sec_Stack_Addr_NT;
227
 
228
   -----------------------------
229
   -- Get_Sec_Stack_Addr_Soft --
230
   -----------------------------
231
 
232
   function Get_Sec_Stack_Addr_Soft return  Address is
233
   begin
234
      return Get_Sec_Stack_Addr.all;
235
   end Get_Sec_Stack_Addr_Soft;
236
 
237
   -----------------------
238
   -- Get_Stack_Info_NT --
239
   -----------------------
240
 
241
   function Get_Stack_Info_NT return Stack_Checking.Stack_Access is
242
   begin
243
      return NT_TSD.Pri_Stack_Info'Access;
244
   end Get_Stack_Info_NT;
245
 
246
   -------------------------------
247
   -- Null_Finalize_Global_List --
248
   -------------------------------
249
 
250
   procedure Null_Finalize_Global_List is
251
   begin
252
      null;
253
   end Null_Finalize_Global_List;
254
 
255
   ---------------------------
256
   -- Set_Jmpbuf_Address_NT --
257
   ---------------------------
258
 
259
   procedure Set_Jmpbuf_Address_NT (Addr : Address) is
260
   begin
261
      NT_TSD.Jmpbuf_Address := Addr;
262
   end Set_Jmpbuf_Address_NT;
263
 
264
   procedure Set_Jmpbuf_Address_Soft (Addr : Address) is
265
   begin
266
      Set_Jmpbuf_Address (Addr);
267
   end Set_Jmpbuf_Address_Soft;
268
 
269
   ---------------------------
270
   -- Set_Sec_Stack_Addr_NT --
271
   ---------------------------
272
 
273
   procedure Set_Sec_Stack_Addr_NT (Addr : Address) is
274
   begin
275
      NT_TSD.Sec_Stack_Addr := Addr;
276
   end Set_Sec_Stack_Addr_NT;
277
 
278
   -----------------------------
279
   -- Set_Sec_Stack_Addr_Soft --
280
   -----------------------------
281
 
282
   procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is
283
   begin
284
      Set_Sec_Stack_Addr (Addr);
285
   end Set_Sec_Stack_Addr_Soft;
286
 
287
   ------------------
288
   -- Task_Lock_NT --
289
   ------------------
290
 
291
   procedure Task_Lock_NT is
292
   begin
293
      null;
294
   end Task_Lock_NT;
295
 
296
   ------------------
297
   -- Task_Name_NT --
298
   -------------------
299
 
300
   function Task_Name_NT return String is
301
   begin
302
      return "main_task";
303
   end Task_Name_NT;
304
 
305
   -------------------------
306
   -- Task_Termination_NT --
307
   -------------------------
308
 
309
   procedure Task_Termination_NT (Excep : EO) is
310
      pragma Unreferenced (Excep);
311
   begin
312
      null;
313
   end Task_Termination_NT;
314
 
315
   --------------------
316
   -- Task_Unlock_NT --
317
   --------------------
318
 
319
   procedure Task_Unlock_NT is
320
   begin
321
      null;
322
   end Task_Unlock_NT;
323
 
324
   -------------------------
325
   -- Update_Exception_NT --
326
   -------------------------
327
 
328
   procedure Update_Exception_NT (X : EO := Current_Target_Exception) is
329
   begin
330
      Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
331
   end Update_Exception_NT;
332
 
333
end System.Soft_Links;

powered by: WebSVN 2.1.0

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