1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Atree; use Atree;
33 with Nlists; use Nlists;
34 with Sinfo; use Sinfo;
35 with Tree_IO; use Tree_IO;
37 with GNAT.HTable; use GNAT.HTable;
39 package body Aspects is
41 ------------------------------------------
42 -- Hash Table for Aspect Specifications --
43 ------------------------------------------
45 type AS_Hash_Range is range 0 .. 510;
46 -- Size of hash table headers
48 function AS_Hash (F : Node_Id) return AS_Hash_Range;
49 -- Hash function for hash table
51 function AS_Hash (F : Node_Id) return AS_Hash_Range is
53 return AS_Hash_Range (F mod 511);
56 package Aspect_Specifications_Hash_Table is new
57 GNAT.HTable.Simple_HTable
58 (Header_Num => AS_Hash_Range,
60 No_Element => No_List,
65 -------------------------------------
66 -- Hash Table for Aspect Id Values --
67 -------------------------------------
69 type AI_Hash_Range is range 0 .. 112;
70 -- Size of hash table headers
72 function AI_Hash (F : Name_Id) return AI_Hash_Range;
73 -- Hash function for hash table
75 function AI_Hash (F : Name_Id) return AI_Hash_Range is
77 return AI_Hash_Range (F mod 113);
80 package Aspect_Id_Hash_Table is new
81 GNAT.HTable.Simple_HTable
82 (Header_Num => AI_Hash_Range,
84 No_Element => No_Aspect,
89 ---------------------------
90 -- Aspect_Specifications --
91 ---------------------------
93 function Aspect_Specifications (N : Node_Id) return List_Id is
95 if Has_Aspects (N) then
96 return Aspect_Specifications_Hash_Table.Get (N);
100 end Aspect_Specifications;
106 function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
108 return Aspect_Id_Hash_Table.Get (Name);
115 procedure Move_Aspects (From : Node_Id; To : Node_Id) is
116 pragma Assert (not Has_Aspects (To));
118 if Has_Aspects (From) then
119 Set_Aspect_Specifications (To, Aspect_Specifications (From));
120 Aspect_Specifications_Hash_Table.Remove (From);
121 Set_Has_Aspects (From, False);
125 -----------------------------------
126 -- Permits_Aspect_Specifications --
127 -----------------------------------
129 Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
130 (N_Abstract_Subprogram_Declaration => True,
131 N_Component_Declaration => True,
132 N_Entry_Declaration => True,
133 N_Exception_Declaration => True,
134 N_Formal_Abstract_Subprogram_Declaration => True,
135 N_Formal_Concrete_Subprogram_Declaration => True,
136 N_Formal_Object_Declaration => True,
137 N_Formal_Package_Declaration => True,
138 N_Formal_Type_Declaration => True,
139 N_Full_Type_Declaration => True,
140 N_Function_Instantiation => True,
141 N_Generic_Package_Declaration => True,
142 N_Generic_Subprogram_Declaration => True,
143 N_Object_Declaration => True,
144 N_Package_Declaration => True,
145 N_Package_Instantiation => True,
146 N_Package_Specification => True,
147 N_Private_Extension_Declaration => True,
148 N_Private_Type_Declaration => True,
149 N_Procedure_Instantiation => True,
150 N_Protected_Body => True,
151 N_Protected_Type_Declaration => True,
152 N_Single_Protected_Declaration => True,
153 N_Single_Task_Declaration => True,
154 N_Subprogram_Body => True,
155 N_Subprogram_Declaration => True,
156 N_Subtype_Declaration => True,
158 N_Task_Type_Declaration => True,
161 function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
163 return Has_Aspect_Specifications_Flag (Nkind (N));
164 end Permits_Aspect_Specifications;
170 -- Table used for Same_Aspect, maps aspect to canonical aspect
172 Canonical_Aspect : constant array (Aspect_Id) of Aspect_Id :=
173 (No_Aspect => No_Aspect,
174 Aspect_Ada_2005 => Aspect_Ada_2005,
175 Aspect_Ada_2012 => Aspect_Ada_2005,
176 Aspect_Address => Aspect_Address,
177 Aspect_Alignment => Aspect_Alignment,
178 Aspect_Atomic => Aspect_Atomic,
179 Aspect_Atomic_Components => Aspect_Atomic_Components,
180 Aspect_Bit_Order => Aspect_Bit_Order,
181 Aspect_Component_Size => Aspect_Component_Size,
182 Aspect_Constant_Indexing => Aspect_Constant_Indexing,
183 Aspect_Default_Component_Value => Aspect_Default_Component_Value,
184 Aspect_Default_Iterator => Aspect_Default_Iterator,
185 Aspect_Default_Value => Aspect_Default_Value,
186 Aspect_Discard_Names => Aspect_Discard_Names,
187 Aspect_Dynamic_Predicate => Aspect_Predicate,
188 Aspect_External_Tag => Aspect_External_Tag,
189 Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
190 Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
191 Aspect_Inline => Aspect_Inline,
192 Aspect_Inline_Always => Aspect_Inline,
193 Aspect_Iterator_Element => Aspect_Iterator_Element,
194 Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
195 Aspect_Compiler_Unit => Aspect_Compiler_Unit,
196 Aspect_Elaborate_Body => Aspect_Elaborate_Body,
197 Aspect_Preelaborate => Aspect_Preelaborate,
198 Aspect_Preelaborate_05 => Aspect_Preelaborate_05,
199 Aspect_Pure => Aspect_Pure,
200 Aspect_Pure_05 => Aspect_Pure_05,
201 Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
202 Aspect_Remote_Types => Aspect_Remote_Types,
203 Aspect_Shared_Passive => Aspect_Shared_Passive,
204 Aspect_Universal_Data => Aspect_Universal_Data,
205 Aspect_Input => Aspect_Input,
206 Aspect_Invariant => Aspect_Invariant,
207 Aspect_Machine_Radix => Aspect_Machine_Radix,
208 Aspect_No_Return => Aspect_No_Return,
209 Aspect_Object_Size => Aspect_Object_Size,
210 Aspect_Output => Aspect_Output,
211 Aspect_Pack => Aspect_Pack,
212 Aspect_Persistent_BSS => Aspect_Persistent_BSS,
213 Aspect_Post => Aspect_Post,
214 Aspect_Postcondition => Aspect_Post,
215 Aspect_Pre => Aspect_Pre,
216 Aspect_Precondition => Aspect_Pre,
217 Aspect_Predicate => Aspect_Predicate,
218 Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
219 Aspect_Pure_Function => Aspect_Pure_Function,
220 Aspect_Read => Aspect_Read,
221 Aspect_Shared => Aspect_Atomic,
222 Aspect_Size => Aspect_Size,
223 Aspect_Static_Predicate => Aspect_Predicate,
224 Aspect_Storage_Pool => Aspect_Storage_Pool,
225 Aspect_Storage_Size => Aspect_Storage_Size,
226 Aspect_Stream_Size => Aspect_Stream_Size,
227 Aspect_Suppress => Aspect_Suppress,
228 Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
229 Aspect_Test_Case => Aspect_Test_Case,
230 Aspect_Type_Invariant => Aspect_Invariant,
231 Aspect_Unchecked_Union => Aspect_Unchecked_Union,
232 Aspect_Universal_Aliasing => Aspect_Universal_Aliasing,
233 Aspect_Unmodified => Aspect_Unmodified,
234 Aspect_Unreferenced => Aspect_Unreferenced,
235 Aspect_Unreferenced_Objects => Aspect_Unreferenced_Objects,
236 Aspect_Unsuppress => Aspect_Unsuppress,
237 Aspect_Variable_Indexing => Aspect_Variable_Indexing,
238 Aspect_Value_Size => Aspect_Value_Size,
239 Aspect_Volatile => Aspect_Volatile,
240 Aspect_Volatile_Components => Aspect_Volatile_Components,
241 Aspect_Warnings => Aspect_Warnings,
242 Aspect_Write => Aspect_Write);
244 function Same_Aspect (A1 : Aspect_Id; A2 : Aspect_Id) return Boolean is
246 return Canonical_Aspect (A1) = Canonical_Aspect (A2);
249 -------------------------------
250 -- Set_Aspect_Specifications --
251 -------------------------------
253 procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
255 pragma Assert (Permits_Aspect_Specifications (N));
256 pragma Assert (not Has_Aspects (N));
257 pragma Assert (L /= No_List);
261 Aspect_Specifications_Hash_Table.Set (N, L);
262 end Set_Aspect_Specifications;
268 procedure Tree_Read is
273 Tree_Read_Int (Int (Node));
274 Tree_Read_Int (Int (List));
275 exit when List = No_List;
276 Set_Aspect_Specifications (Node, List);
284 procedure Tree_Write is
285 Node : Node_Id := Empty;
288 Aspect_Specifications_Hash_Table.Get_First (Node, List);
290 Tree_Write_Int (Int (Node));
291 Tree_Write_Int (Int (List));
292 exit when List = No_List;
293 Aspect_Specifications_Hash_Table.Get_Next (Node, List);
297 -- Package initialization sets up Aspect Id hash table
300 for J in Aspect_Id loop
301 Aspect_Id_Hash_Table.Set (Aspect_Names (J), J);