]>
Commit | Line | Data |
---|---|---|
cacbc350 RK |
1 | ------------------------------------------------------------------------------ |
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 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
cacbc350 RK |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
cacbc350 RK |
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 -- | |
748086b7 JJ |
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/>. -- | |
cacbc350 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
cacbc350 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
e917e3b8 | 32 | pragma Compiler_Unit_Warning; |
2d9ea47f | 33 | |
cacbc350 | 34 | pragma Polling (Off); |
366b8af7 RD |
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. | |
cacbc350 | 37 | |
3b91d88e | 38 | pragma Warnings (Off); |
bad0a3df PMR |
39 | -- Disable warnings as System.Soft_Links.Initialize is not Preelaborate. It is |
40 | -- safe to with this unit as its elaboration routine will only be initializing | |
41 | -- NT_TSD, which is part of this package spec. | |
42 | with System.Soft_Links.Initialize; | |
3b91d88e | 43 | pragma Warnings (On); |
cacbc350 RK |
44 | |
45 | package body System.Soft_Links is | |
46 | ||
22a4f9d5 | 47 | Stack_Limit : aliased System.Address := System.Null_Address; |
3a2b1457 | 48 | pragma Export (C, Stack_Limit, "__gnat_stack_limit"); |
bad0a3df PMR |
49 | -- Needed for Vx6Cert (Vx653mc) GOS cert and ravenscar-cert runtimes, |
50 | -- VxMILS cert, ravenscar-cert and full runtimes, Vx 5 default runtime | |
3a2b1457 | 51 | |
cacbc350 RK |
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 | ||
81408d49 DR |
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 | ||
df3e68b1 | 93 | -- Finalize all library-level controlled objects if needed |
81408d49 | 94 | |
72d5c70b | 95 | if Finalize_Library_Objects /= null then |
df3e68b1 HK |
96 | Finalize_Library_Objects.all; |
97 | end if; | |
81408d49 DR |
98 | end Adafinal_NT; |
99 | ||
cacbc350 RK |
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 | ||
bad0a3df PMR |
122 | procedure Create_TSD |
123 | (New_TSD : in out TSD; | |
124 | Sec_Stack : SST.SS_Stack_Ptr; | |
125 | Sec_Stack_Size : System.Parameters.Size_Type) | |
126 | is | |
07fc65c4 | 127 | begin |
bad0a3df PMR |
128 | New_TSD.Jmpbuf_Address := Null_Address; |
129 | ||
130 | New_TSD.Sec_Stack_Ptr := Sec_Stack; | |
131 | SST.SS_Init (New_TSD.Sec_Stack_Ptr, Sec_Stack_Size); | |
cacbc350 RK |
132 | end Create_TSD; |
133 | ||
134 | ----------------------- | |
135 | -- Current_Master_NT -- | |
136 | ----------------------- | |
137 | ||
138 | function Current_Master_NT return Integer is | |
139 | begin | |
140 | return 0; | |
141 | end Current_Master_NT; | |
142 | ||
143 | ----------------- | |
144 | -- Destroy_TSD -- | |
145 | ----------------- | |
146 | ||
147 | procedure Destroy_TSD (Old_TSD : in out TSD) is | |
148 | begin | |
bad0a3df | 149 | SST.SS_Free (Old_TSD.Sec_Stack_Ptr); |
cacbc350 RK |
150 | end Destroy_TSD; |
151 | ||
152 | --------------------- | |
153 | -- Enter_Master_NT -- | |
154 | --------------------- | |
155 | ||
156 | procedure Enter_Master_NT is | |
157 | begin | |
158 | null; | |
159 | end Enter_Master_NT; | |
160 | ||
161 | -------------------------- | |
162 | -- Get_Current_Excep_NT -- | |
163 | -------------------------- | |
164 | ||
165 | function Get_Current_Excep_NT return EOA is | |
166 | begin | |
167 | return NT_TSD.Current_Excep'Access; | |
168 | end Get_Current_Excep_NT; | |
169 | ||
cacbc350 RK |
170 | ------------------------ |
171 | -- Get_GNAT_Exception -- | |
172 | ------------------------ | |
173 | ||
174 | function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is | |
175 | begin | |
176 | return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all); | |
177 | end Get_GNAT_Exception; | |
178 | ||
179 | --------------------------- | |
180 | -- Get_Jmpbuf_Address_NT -- | |
181 | --------------------------- | |
182 | ||
183 | function Get_Jmpbuf_Address_NT return Address is | |
184 | begin | |
185 | return NT_TSD.Jmpbuf_Address; | |
186 | end Get_Jmpbuf_Address_NT; | |
187 | ||
188 | ----------------------------- | |
189 | -- Get_Jmpbuf_Address_Soft -- | |
190 | ----------------------------- | |
191 | ||
192 | function Get_Jmpbuf_Address_Soft return Address is | |
193 | begin | |
194 | return Get_Jmpbuf_Address.all; | |
195 | end Get_Jmpbuf_Address_Soft; | |
196 | ||
bad0a3df PMR |
197 | ---------------------- |
198 | -- Get_Sec_Stack_NT -- | |
199 | ---------------------- | |
cacbc350 | 200 | |
bad0a3df | 201 | function Get_Sec_Stack_NT return SST.SS_Stack_Ptr is |
cacbc350 | 202 | begin |
bad0a3df PMR |
203 | return NT_TSD.Sec_Stack_Ptr; |
204 | end Get_Sec_Stack_NT; | |
cacbc350 RK |
205 | |
206 | ----------------------------- | |
bad0a3df | 207 | -- Get_Sec_Stack_Soft -- |
cacbc350 RK |
208 | ----------------------------- |
209 | ||
bad0a3df | 210 | function Get_Sec_Stack_Soft return SST.SS_Stack_Ptr is |
cacbc350 | 211 | begin |
bad0a3df PMR |
212 | return Get_Sec_Stack.all; |
213 | end Get_Sec_Stack_Soft; | |
cacbc350 RK |
214 | |
215 | ----------------------- | |
216 | -- Get_Stack_Info_NT -- | |
217 | ----------------------- | |
218 | ||
219 | function Get_Stack_Info_NT return Stack_Checking.Stack_Access is | |
220 | begin | |
221 | return NT_TSD.Pri_Stack_Info'Access; | |
222 | end Get_Stack_Info_NT; | |
223 | ||
df3e68b1 HK |
224 | ----------------------------- |
225 | -- Save_Library_Occurrence -- | |
226 | ----------------------------- | |
cacbc350 | 227 | |
e5a22243 | 228 | procedure Save_Library_Occurrence (E : EOA) is |
23adb371 | 229 | use Ada.Exceptions; |
cacbc350 | 230 | begin |
df3e68b1 HK |
231 | if not Library_Exception_Set then |
232 | Library_Exception_Set := True; | |
23adb371 AC |
233 | if E /= null then |
234 | Ada.Exceptions.Save_Occurrence (Library_Exception, E.all); | |
235 | end if; | |
df3e68b1 HK |
236 | end if; |
237 | end Save_Library_Occurrence; | |
cacbc350 | 238 | |
cacbc350 RK |
239 | --------------------------- |
240 | -- Set_Jmpbuf_Address_NT -- | |
241 | --------------------------- | |
242 | ||
243 | procedure Set_Jmpbuf_Address_NT (Addr : Address) is | |
244 | begin | |
245 | NT_TSD.Jmpbuf_Address := Addr; | |
246 | end Set_Jmpbuf_Address_NT; | |
247 | ||
248 | procedure Set_Jmpbuf_Address_Soft (Addr : Address) is | |
249 | begin | |
250 | Set_Jmpbuf_Address (Addr); | |
251 | end Set_Jmpbuf_Address_Soft; | |
252 | ||
bad0a3df PMR |
253 | ---------------------- |
254 | -- Set_Sec_Stack_NT -- | |
255 | ---------------------- | |
cacbc350 | 256 | |
bad0a3df | 257 | procedure Set_Sec_Stack_NT (Stack : SST.SS_Stack_Ptr) is |
cacbc350 | 258 | begin |
bad0a3df PMR |
259 | NT_TSD.Sec_Stack_Ptr := Stack; |
260 | end Set_Sec_Stack_NT; | |
cacbc350 | 261 | |
bad0a3df PMR |
262 | ------------------------ |
263 | -- Set_Sec_Stack_Soft -- | |
264 | ------------------------ | |
cacbc350 | 265 | |
bad0a3df | 266 | procedure Set_Sec_Stack_Soft (Stack : SST.SS_Stack_Ptr) is |
cacbc350 | 267 | begin |
bad0a3df PMR |
268 | Set_Sec_Stack (Stack); |
269 | end Set_Sec_Stack_Soft; | |
cacbc350 RK |
270 | |
271 | ------------------ | |
272 | -- Task_Lock_NT -- | |
273 | ------------------ | |
274 | ||
275 | procedure Task_Lock_NT is | |
276 | begin | |
277 | null; | |
278 | end Task_Lock_NT; | |
279 | ||
bfc8aa81 RD |
280 | ------------------ |
281 | -- Task_Name_NT -- | |
282 | ------------------- | |
cacbc350 | 283 | |
bfc8aa81 | 284 | function Task_Name_NT return String is |
cacbc350 | 285 | begin |
bfc8aa81 RD |
286 | return "main_task"; |
287 | end Task_Name_NT; | |
cacbc350 | 288 | |
81408d49 DR |
289 | ------------------------- |
290 | -- Task_Termination_NT -- | |
291 | ------------------------- | |
292 | ||
293 | procedure Task_Termination_NT (Excep : EO) is | |
74e63df1 | 294 | pragma Unreferenced (Excep); |
81408d49 DR |
295 | begin |
296 | null; | |
297 | end Task_Termination_NT; | |
298 | ||
bfc8aa81 RD |
299 | -------------------- |
300 | -- Task_Unlock_NT -- | |
301 | -------------------- | |
302 | ||
303 | procedure Task_Unlock_NT is | |
304 | begin | |
305 | null; | |
306 | end Task_Unlock_NT; | |
cacbc350 | 307 | end System.Soft_Links; |