File : s-soflin-cert.adb
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 -- --
9 -- Copyright (C) 1992-2015, 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 -- --
19 -- --
20 -- --
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 package body System.Soft_Links is
33
34 NT_TSD : TSD;
35 -- Note: we rely on the default initialization of NT_TSD
36
37 -- Needed for Vx6Cert (Vx653mc) GOS cert and ravenscar-cert runtimes,
38 -- VxMILS cert, ravenscar-cert and full runtimes, Vx 5 default runtime
39 Stack_Limit : aliased System.Address;
40
41 pragma Export (C, Stack_Limit, "__gnat_stack_limit");
42
43 ------------------------
44 -- Get_GNAT_Exception --
45 ------------------------
46
47 function Get_GNAT_Exception return Ada.Exceptions.Exception_Id is
48 begin
49 return Ada.Exceptions.Exception_Identity (Get_Current_Excep.all.all);
50 end Get_GNAT_Exception;
51
52 --------------------------
53 -- Get_Current_Excep_NT --
54 --------------------------
55
56 function Get_Current_Excep_NT return EOA is
57 begin
58 return NT_TSD.Current_Excep'Access;
59 end Get_Current_Excep_NT;
60
61 ---------------------------
62 -- Get_Jmpbuf_Address_NT --
63 ---------------------------
64
65 function Get_Jmpbuf_Address_NT return Address is
66 begin
67 return NT_TSD.Jmpbuf_Address;
68 end Get_Jmpbuf_Address_NT;
69
70 -----------------------------
71 -- Get_Jmpbuf_Address_Soft --
72 -----------------------------
73
74 function Get_Jmpbuf_Address_Soft return Address is
75 begin
76 return Get_Jmpbuf_Address.all;
77 end Get_Jmpbuf_Address_Soft;
78
79 ---------------------------
80 -- Get_Sec_Stack_Addr_NT --
81 ---------------------------
82
83 function Get_Sec_Stack_Addr_NT return Address is
84 begin
85 return NT_TSD.Sec_Stack_Addr;
86 end Get_Sec_Stack_Addr_NT;
87
88 -----------------------------
89 -- Get_Sec_Stack_Addr_Soft --
90 -----------------------------
91
92 function Get_Sec_Stack_Addr_Soft return Address is
93 begin
94 return Get_Sec_Stack_Addr.all;
95 end Get_Sec_Stack_Addr_Soft;
96
97 -------------------
98 -- Null_Adafinal --
99 -------------------
100
101 procedure Null_Adafinal is
102 begin
103 null;
104 end Null_Adafinal;
105
106 ---------------------------
107 -- Set_Jmpbuf_Address_NT --
108 ---------------------------
109
110 procedure Set_Jmpbuf_Address_NT (Addr : Address) is
111 begin
112 NT_TSD.Jmpbuf_Address := Addr;
113 end Set_Jmpbuf_Address_NT;
114
115 -----------------------------
116 -- Set_Jmpbuf_Address_Soft --
117 -----------------------------
118
119 procedure Set_Jmpbuf_Address_Soft (Addr : Address) is
120 begin
121 Set_Jmpbuf_Address (Addr);
122 end Set_Jmpbuf_Address_Soft;
123
124 ---------------------------
125 -- Set_Sec_Stack_Addr_NT --
126 ---------------------------
127
128 procedure Set_Sec_Stack_Addr_NT (Addr : Address) is
129 begin
130 NT_TSD.Sec_Stack_Addr := Addr;
131 end Set_Sec_Stack_Addr_NT;
132
133 -----------------------------
134 -- Set_Sec_Stack_Addr_Soft --
135 -----------------------------
136
137 procedure Set_Sec_Stack_Addr_Soft (Addr : Address) is
138 begin
139 Set_Sec_Stack_Addr (Addr);
140 end Set_Sec_Stack_Addr_Soft;
141
142 end System.Soft_Links;