1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- B I N D O . U N I T S --
9 -- Copyright (C) 2019-2020, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
28 use Bindo.Writers.Phase_Writers;
30 package body Bindo.Units is
36 package Signature_Sets is new Membership_Sets
37 (Element_Type => Invocation_Signature_Id,
39 Hash => Hash_Invocation_Signature);
45 -- The following set stores all invocation signatures that appear in
48 Elaborable_Constructs : Signature_Sets.Membership_Set := Signature_Sets.Nil;
50 -- The following set stores all units the need to be elaborated
52 Elaborable_Units : Unit_Sets.Membership_Set := Unit_Sets.Nil;
54 -----------------------
55 -- Local subprograms --
56 -----------------------
58 function Corresponding_Unit (Nam : Name_Id) return Unit_Id;
59 pragma Inline (Corresponding_Unit);
60 -- Obtain the unit which corresponds to name Nam
62 function Is_Stand_Alone_Library_Unit (U_Id : Unit_Id) return Boolean;
63 pragma Inline (Is_Stand_Alone_Library_Unit);
64 -- Determine whether unit U_Id is part of a stand-alone library
66 procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id);
67 pragma Inline (Process_Invocation_Construct);
68 -- Process invocation construct IC_Id by adding its signature to set
69 -- Elaborable_Constructs_Set.
71 procedure Process_Invocation_Constructs (U_Id : Unit_Id);
72 pragma Inline (Process_Invocation_Constructs);
73 -- Process all invocation constructs of unit U_Id for classification
76 procedure Process_Unit (U_Id : Unit_Id);
77 pragma Inline (Process_Unit);
78 -- Process unit U_Id for unit classification purposes
80 ------------------------------
81 -- Collect_Elaborable_Units --
82 ------------------------------
84 procedure Collect_Elaborable_Units is
86 Start_Phase (Unit_Collection);
88 for U_Id in ALI.Units.First .. ALI.Units.Last loop
92 End_Phase (Unit_Collection);
93 end Collect_Elaborable_Units;
95 ------------------------
96 -- Corresponding_Body --
97 ------------------------
99 function Corresponding_Body (U_Id : Unit_Id) return Unit_Id is
100 pragma Assert (Present (U_Id));
102 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
105 pragma Assert (U_Rec.Utype = Is_Spec);
107 end Corresponding_Body;
109 ------------------------
110 -- Corresponding_Spec --
111 ------------------------
113 function Corresponding_Spec (U_Id : Unit_Id) return Unit_Id is
114 pragma Assert (Present (U_Id));
116 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
119 pragma Assert (U_Rec.Utype = Is_Body);
121 end Corresponding_Spec;
123 ------------------------
124 -- Corresponding_Unit --
125 ------------------------
127 function Corresponding_Unit (FNam : File_Name_Type) return Unit_Id is
129 return Corresponding_Unit (Name_Id (FNam));
130 end Corresponding_Unit;
132 ------------------------
133 -- Corresponding_Unit --
134 ------------------------
136 function Corresponding_Unit (Nam : Name_Id) return Unit_Id is
138 return Unit_Id (Get_Name_Table_Int (Nam));
139 end Corresponding_Unit;
141 ------------------------
142 -- Corresponding_Unit --
143 ------------------------
145 function Corresponding_Unit (UNam : Unit_Name_Type) return Unit_Id is
147 return Corresponding_Unit (Name_Id (UNam));
148 end Corresponding_Unit;
154 function File_Name (U_Id : Unit_Id) return File_Name_Type is
155 pragma Assert (Present (U_Id));
157 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
167 procedure Finalize_Units is
169 Signature_Sets.Destroy (Elaborable_Constructs);
170 Unit_Sets.Destroy (Elaborable_Units);
173 ------------------------------
174 -- For_Each_Elaborable_Unit --
175 ------------------------------
177 procedure For_Each_Elaborable_Unit (Processor : Unit_Processor_Ptr) is
178 Iter : Elaborable_Units_Iterator;
182 Iter := Iterate_Elaborable_Units;
183 while Has_Next (Iter) loop
186 Processor.all (U_Id);
188 end For_Each_Elaborable_Unit;
194 procedure For_Each_Unit (Processor : Unit_Processor_Ptr) is
196 for U_Id in ALI.Units.First .. ALI.Units.Last loop
197 Processor.all (U_Id);
205 function Has_Next (Iter : Elaborable_Units_Iterator) return Boolean is
207 return Unit_Sets.Has_Next (Unit_Sets.Iterator (Iter));
210 -----------------------------
211 -- Has_No_Elaboration_Code --
212 -----------------------------
214 function Has_No_Elaboration_Code (U_Id : Unit_Id) return Boolean is
215 pragma Assert (Present (U_Id));
217 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
220 return U_Rec.No_Elab;
221 end Has_No_Elaboration_Code;
223 -------------------------------
224 -- Hash_Invocation_Signature --
225 -------------------------------
227 function Hash_Invocation_Signature
228 (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type
231 pragma Assert (Present (IS_Id));
233 return Bucket_Range_Type (IS_Id);
234 end Hash_Invocation_Signature;
240 function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type is
242 pragma Assert (Present (U_Id));
244 return Bucket_Range_Type (U_Id);
247 ----------------------
248 -- Initialize_Units --
249 ----------------------
251 procedure Initialize_Units is
253 Elaborable_Constructs := Signature_Sets.Create (Number_Of_Units);
254 Elaborable_Units := Unit_Sets.Create (Number_Of_Units);
255 end Initialize_Units;
257 -------------------------------
258 -- Invocation_Graph_Encoding --
259 -------------------------------
261 function Invocation_Graph_Encoding
262 (U_Id : Unit_Id) return Invocation_Graph_Encoding_Kind
264 pragma Assert (Present (U_Id));
266 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
267 U_ALI : ALIs_Record renames ALI.ALIs.Table (U_Rec.My_ALI);
270 return U_ALI.Invocation_Graph_Encoding;
271 end Invocation_Graph_Encoding;
273 -------------------------------
274 -- Is_Dynamically_Elaborated --
275 -------------------------------
277 function Is_Dynamically_Elaborated (U_Id : Unit_Id) return Boolean is
278 pragma Assert (Present (U_Id));
280 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
283 return U_Rec.Dynamic_Elab;
284 end Is_Dynamically_Elaborated;
286 ----------------------
287 -- Is_Internal_Unit --
288 ----------------------
290 function Is_Internal_Unit (U_Id : Unit_Id) return Boolean is
291 pragma Assert (Present (U_Id));
293 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
296 return U_Rec.Internal;
297 end Is_Internal_Unit;
299 ------------------------
300 -- Is_Predefined_Unit --
301 ------------------------
303 function Is_Predefined_Unit (U_Id : Unit_Id) return Boolean is
304 pragma Assert (Present (U_Id));
306 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
309 return U_Rec.Predefined;
310 end Is_Predefined_Unit;
312 ---------------------------------
313 -- Is_Stand_Alone_Library_Unit --
314 ---------------------------------
316 function Is_Stand_Alone_Library_Unit (U_Id : Unit_Id) return Boolean is
317 pragma Assert (Present (U_Id));
319 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
322 return U_Rec.SAL_Interface;
323 end Is_Stand_Alone_Library_Unit;
325 ------------------------------
326 -- Iterate_Elaborable_Units --
327 ------------------------------
329 function Iterate_Elaborable_Units return Elaborable_Units_Iterator is
331 return Elaborable_Units_Iterator (Unit_Sets.Iterate (Elaborable_Units));
332 end Iterate_Elaborable_Units;
338 function Name (U_Id : Unit_Id) return Unit_Name_Type is
339 pragma Assert (Present (U_Id));
341 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
347 -----------------------
348 -- Needs_Elaboration --
349 -----------------------
351 function Needs_Elaboration
352 (IS_Id : Invocation_Signature_Id) return Boolean
355 pragma Assert (Present (IS_Id));
357 return Signature_Sets.Contains (Elaborable_Constructs, IS_Id);
358 end Needs_Elaboration;
360 -----------------------
361 -- Needs_Elaboration --
362 -----------------------
364 function Needs_Elaboration (U_Id : Unit_Id) return Boolean is
366 pragma Assert (Present (U_Id));
368 return Unit_Sets.Contains (Elaborable_Units, U_Id);
369 end Needs_Elaboration;
376 (Iter : in out Elaborable_Units_Iterator;
380 Unit_Sets.Next (Unit_Sets.Iterator (Iter), U_Id);
383 --------------------------------
384 -- Number_Of_Elaborable_Units --
385 --------------------------------
387 function Number_Of_Elaborable_Units return Natural is
389 return Unit_Sets.Size (Elaborable_Units);
390 end Number_Of_Elaborable_Units;
392 ---------------------
393 -- Number_Of_Units --
394 ---------------------
396 function Number_Of_Units return Natural is
398 return Natural (ALI.Units.Last) - Natural (ALI.Units.First) + 1;
401 ----------------------------------
402 -- Process_Invocation_Construct --
403 ----------------------------------
405 procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
406 pragma Assert (Present (IC_Id));
408 IS_Id : constant Invocation_Signature_Id := Signature (IC_Id);
410 pragma Assert (Present (IS_Id));
413 Signature_Sets.Insert (Elaborable_Constructs, IS_Id);
414 end Process_Invocation_Construct;
416 -----------------------------------
417 -- Process_Invocation_Constructs --
418 -----------------------------------
420 procedure Process_Invocation_Constructs (U_Id : Unit_Id) is
421 pragma Assert (Present (U_Id));
423 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
426 for IC_Id in U_Rec.First_Invocation_Construct ..
427 U_Rec.Last_Invocation_Construct
429 Process_Invocation_Construct (IC_Id);
431 end Process_Invocation_Constructs;
437 procedure Process_Unit (U_Id : Unit_Id) is
439 pragma Assert (Present (U_Id));
441 -- A stand-alone library unit must not be elaborated as part of the
442 -- current compilation because the library already carries its own
445 if Is_Stand_Alone_Library_Unit (U_Id) then
448 -- Otherwise the unit needs to be elaborated. Add it to the set
449 -- of units that require elaboration, as well as all invocation
450 -- signatures of constructs it declares.
453 Unit_Sets.Insert (Elaborable_Units, U_Id);
454 Process_Invocation_Constructs (U_Id);