1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- B I N D O . U N I T S --
9 -- Copyright (C) 2019-2023, 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
);