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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 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-2011, 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_TSD : TSD;
50
   --  Note: we rely on the default initialization of NT_TSD
51
 
52
   --------------------
53
   -- Abort_Defer_NT --
54
   --------------------
55
 
56
   procedure Abort_Defer_NT is
57
   begin
58
      null;
59
   end Abort_Defer_NT;
60
 
61
   ----------------------
62
   -- Abort_Handler_NT --
63
   ----------------------
64
 
65
   procedure Abort_Handler_NT is
66
   begin
67
      null;
68
   end Abort_Handler_NT;
69
 
70
   ----------------------
71
   -- Abort_Undefer_NT --
72
   ----------------------
73
 
74
   procedure Abort_Undefer_NT is
75
   begin
76
      null;
77
   end Abort_Undefer_NT;
78
 
79
   -----------------
80
   -- Adafinal_NT --
81
   -----------------
82
 
83
   procedure Adafinal_NT is
84
   begin
85
      --  Handle normal task termination by the environment task, but only
86
      --  for the normal task termination. In the case of Abnormal and
87
      --  Unhandled_Exception they must have been handled before, and the
88
      --  task termination soft link must have been changed so the task
89
      --  termination routine is not executed twice.
90
 
91
      Task_Termination_Handler.all (Ada.Exceptions.Null_Occurrence);
92
 
93
      --  Finalize all library-level controlled objects if needed
94
 
95
      if Finalize_Library_Objects /=  null then
96
         Finalize_Library_Objects.all;
97
      end if;
98
   end Adafinal_NT;
99
 
100
   ---------------------------
101
   -- Check_Abort_Status_NT --
102
   ---------------------------
103
 
104
   function Check_Abort_Status_NT return Integer is
105
   begin
106
      return Boolean'Pos (False);
107
   end Check_Abort_Status_NT;
108
 
109
   ------------------------
110
   -- Complete_Master_NT --
111
   ------------------------
112
 
113
   procedure Complete_Master_NT is
114
   begin
115
      null;
116
   end Complete_Master_NT;
117
 
118
   ----------------
119
   -- Create_TSD --
120
   ----------------
121
 
122
   procedure Create_TSD (New_TSD : in out TSD) is
123
      use Parameters;
124
      SS_Ratio_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic;
125
   begin
126
      if SS_Ratio_Dynamic then
127
         SST.SS_Init
128
           (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
129
      end if;
130
   end Create_TSD;
131
 
132
   -----------------------
133
   -- Current_Master_NT --
134
   -----------------------
135
 
136
   function Current_Master_NT return Integer is
137
   begin
138
      return 0;
139
   end Current_Master_NT;
140
 
141
   -----------------
142
   -- Destroy_TSD --
143
   -----------------
144
 
145
   procedure Destroy_TSD (Old_TSD : in out TSD) is
146
   begin
147
      SST.SS_Free (Old_TSD.Sec_Stack_Addr);
148
   end Destroy_TSD;
149
 
150
   ---------------------
151
   -- Enter_Master_NT --
152
   ---------------------
153
 
154
   procedure Enter_Master_NT is
155
   begin
156
      null;
157
   end Enter_Master_NT;
158
 
159
   --------------------------
160
   -- Get_Current_Excep_NT --
161
   --------------------------
162
 
163
   function Get_Current_Excep_NT return EOA is
164
   begin
165
      return NT_TSD.Current_Excep'Access;
166
   end Get_Current_Excep_NT;
167
 
168
   ------------------------
169
   -- Get_GNAT_Exception --
170
   ------------------------
171
 
172
   function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is
173
   begin
174
      return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all);
175
   end Get_GNAT_Exception;
176
 
177
   ---------------------------
178
   -- Get_Jmpbuf_Address_NT --
179
   ---------------------------
180
 
181
   function Get_Jmpbuf_Address_NT return  Address is
182
   begin
183
      return NT_TSD.Jmpbuf_Address;
184
   end Get_Jmpbuf_Address_NT;
185
 
186
   -----------------------------
187
   -- Get_Jmpbuf_Address_Soft --
188
   -----------------------------
189
 
190
   function Get_Jmpbuf_Address_Soft return  Address is
191
   begin
192
      return Get_Jmpbuf_Address.all;
193
   end Get_Jmpbuf_Address_Soft;
194
 
195
   ---------------------------
196
   -- Get_Sec_Stack_Addr_NT --
197
   ---------------------------
198
 
199
   function Get_Sec_Stack_Addr_NT return  Address is
200
   begin
201
      return NT_TSD.Sec_Stack_Addr;
202
   end Get_Sec_Stack_Addr_NT;
203
 
204
   -----------------------------
205
   -- Get_Sec_Stack_Addr_Soft --
206
   -----------------------------
207
 
208
   function Get_Sec_Stack_Addr_Soft return  Address is
209
   begin
210
      return Get_Sec_Stack_Addr.all;
211
   end Get_Sec_Stack_Addr_Soft;
212
 
213
   -----------------------
214
   -- Get_Stack_Info_NT --
215
   -----------------------
216
 
217
   function Get_Stack_Info_NT return Stack_Checking.Stack_Access is
218
   begin
219
      return NT_TSD.Pri_Stack_Info'Access;
220
   end Get_Stack_Info_NT;
221
 
222
   -----------------------------
223
   -- Save_Library_Occurrence --
224
   -----------------------------
225
 
226
   procedure Save_Library_Occurrence
227
     (E : Ada.Exceptions.Exception_Occurrence)
228
   is
229
   begin
230
      if not Library_Exception_Set then
231
         Library_Exception_Set := True;
232
         Ada.Exceptions.Save_Occurrence (Library_Exception, E);
233
      end if;
234
   end Save_Library_Occurrence;
235
 
236
   ---------------------------
237
   -- Set_Jmpbuf_Address_NT --
238
   ---------------------------
239
 
240
   procedure Set_Jmpbuf_Address_NT (Addr : Address) is
241
   begin
242
      NT_TSD.Jmpbuf_Address := Addr;
243
   end Set_Jmpbuf_Address_NT;
244
 
245
   procedure Set_Jmpbuf_Address_Soft (Addr : Address) is
246
   begin
247
      Set_Jmpbuf_Address (Addr);
248
   end Set_Jmpbuf_Address_Soft;
249
 
250
   ---------------------------
251
   -- Set_Sec_Stack_Addr_NT --
252
   ---------------------------
253
 
254
   procedure Set_Sec_Stack_Addr_NT (Addr : Address) is
255
   begin
256
      NT_TSD.Sec_Stack_Addr := Addr;
257
   end Set_Sec_Stack_Addr_NT;
258
 
259
   -----------------------------
260
   -- Set_Sec_Stack_Addr_Soft --
261
   -----------------------------
262
 
263
   procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is
264
   begin
265
      Set_Sec_Stack_Addr (Addr);
266
   end Set_Sec_Stack_Addr_Soft;
267
 
268
   ------------------
269
   -- Task_Lock_NT --
270
   ------------------
271
 
272
   procedure Task_Lock_NT is
273
   begin
274
      null;
275
   end Task_Lock_NT;
276
 
277
   ------------------
278
   -- Task_Name_NT --
279
   -------------------
280
 
281
   function Task_Name_NT return String is
282
   begin
283
      return "main_task";
284
   end Task_Name_NT;
285
 
286
   -------------------------
287
   -- Task_Termination_NT --
288
   -------------------------
289
 
290
   procedure Task_Termination_NT (Excep : EO) is
291
      pragma Unreferenced (Excep);
292
   begin
293
      null;
294
   end Task_Termination_NT;
295
 
296
   --------------------
297
   -- Task_Unlock_NT --
298
   --------------------
299
 
300
   procedure Task_Unlock_NT is
301
   begin
302
      null;
303
   end Task_Unlock_NT;
304
 
305
   -------------------------
306
   -- Update_Exception_NT --
307
   -------------------------
308
 
309
   procedure Update_Exception_NT (X : EO := Current_Target_Exception) is
310
   begin
311
      Ada.Exceptions.Save_Occurrence (NT_TSD.Current_Excep, X);
312
   end Update_Exception_NT;
313
 
314
end System.Soft_Links;

powered by: WebSVN 2.1.0

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