1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- B I N D O . U N I T S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2019-2020, 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. 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. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Bindo.Writers; 27use Bindo.Writers; 28use Bindo.Writers.Phase_Writers; 29 30package body Bindo.Units is 31 32 ------------------- 33 -- Signature set -- 34 ------------------- 35 36 package Signature_Sets is new Membership_Sets 37 (Element_Type => Invocation_Signature_Id, 38 "=" => "=", 39 Hash => Hash_Invocation_Signature); 40 41 ----------------- 42 -- Global data -- 43 ----------------- 44 45 -- The following set stores all invocation signatures that appear in 46 -- elaborable units. 47 48 Elaborable_Constructs : Signature_Sets.Membership_Set := Signature_Sets.Nil; 49 50 -- The following set stores all units the need to be elaborated 51 52 Elaborable_Units : Unit_Sets.Membership_Set := Unit_Sets.Nil; 53 54 ----------------------- 55 -- Local subprograms -- 56 ----------------------- 57 58 function Corresponding_Unit (Nam : Name_Id) return Unit_Id; 59 pragma Inline (Corresponding_Unit); 60 -- Obtain the unit which corresponds to name Nam 61 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 65 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. 70 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 74 -- purposes. 75 76 procedure Process_Unit (U_Id : Unit_Id); 77 pragma Inline (Process_Unit); 78 -- Process unit U_Id for unit classification purposes 79 80 ------------------------------ 81 -- Collect_Elaborable_Units -- 82 ------------------------------ 83 84 procedure Collect_Elaborable_Units is 85 begin 86 Start_Phase (Unit_Collection); 87 88 for U_Id in ALI.Units.First .. ALI.Units.Last loop 89 Process_Unit (U_Id); 90 end loop; 91 92 End_Phase (Unit_Collection); 93 end Collect_Elaborable_Units; 94 95 ------------------------ 96 -- Corresponding_Body -- 97 ------------------------ 98 99 function Corresponding_Body (U_Id : Unit_Id) return Unit_Id is 100 pragma Assert (Present (U_Id)); 101 102 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 103 104 begin 105 pragma Assert (U_Rec.Utype = Is_Spec); 106 return U_Id - 1; 107 end Corresponding_Body; 108 109 ------------------------ 110 -- Corresponding_Spec -- 111 ------------------------ 112 113 function Corresponding_Spec (U_Id : Unit_Id) return Unit_Id is 114 pragma Assert (Present (U_Id)); 115 116 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 117 118 begin 119 pragma Assert (U_Rec.Utype = Is_Body); 120 return U_Id + 1; 121 end Corresponding_Spec; 122 123 ------------------------ 124 -- Corresponding_Unit -- 125 ------------------------ 126 127 function Corresponding_Unit (FNam : File_Name_Type) return Unit_Id is 128 begin 129 return Corresponding_Unit (Name_Id (FNam)); 130 end Corresponding_Unit; 131 132 ------------------------ 133 -- Corresponding_Unit -- 134 ------------------------ 135 136 function Corresponding_Unit (Nam : Name_Id) return Unit_Id is 137 begin 138 return Unit_Id (Get_Name_Table_Int (Nam)); 139 end Corresponding_Unit; 140 141 ------------------------ 142 -- Corresponding_Unit -- 143 ------------------------ 144 145 function Corresponding_Unit (UNam : Unit_Name_Type) return Unit_Id is 146 begin 147 return Corresponding_Unit (Name_Id (UNam)); 148 end Corresponding_Unit; 149 150 --------------- 151 -- File_Name -- 152 --------------- 153 154 function File_Name (U_Id : Unit_Id) return File_Name_Type is 155 pragma Assert (Present (U_Id)); 156 157 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 158 159 begin 160 return U_Rec.Sfile; 161 end File_Name; 162 163 -------------------- 164 -- Finalize_Units -- 165 -------------------- 166 167 procedure Finalize_Units is 168 begin 169 Signature_Sets.Destroy (Elaborable_Constructs); 170 Unit_Sets.Destroy (Elaborable_Units); 171 end Finalize_Units; 172 173 ------------------------------ 174 -- For_Each_Elaborable_Unit -- 175 ------------------------------ 176 177 procedure For_Each_Elaborable_Unit (Processor : Unit_Processor_Ptr) is 178 Iter : Elaborable_Units_Iterator; 179 U_Id : Unit_Id; 180 181 begin 182 Iter := Iterate_Elaborable_Units; 183 while Has_Next (Iter) loop 184 Next (Iter, U_Id); 185 186 Processor.all (U_Id); 187 end loop; 188 end For_Each_Elaborable_Unit; 189 190 ------------------- 191 -- For_Each_Unit -- 192 ------------------- 193 194 procedure For_Each_Unit (Processor : Unit_Processor_Ptr) is 195 begin 196 for U_Id in ALI.Units.First .. ALI.Units.Last loop 197 Processor.all (U_Id); 198 end loop; 199 end For_Each_Unit; 200 201 -------------- 202 -- Has_Next -- 203 -------------- 204 205 function Has_Next (Iter : Elaborable_Units_Iterator) return Boolean is 206 begin 207 return Unit_Sets.Has_Next (Unit_Sets.Iterator (Iter)); 208 end Has_Next; 209 210 ----------------------------- 211 -- Has_No_Elaboration_Code -- 212 ----------------------------- 213 214 function Has_No_Elaboration_Code (U_Id : Unit_Id) return Boolean is 215 pragma Assert (Present (U_Id)); 216 217 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 218 219 begin 220 return U_Rec.No_Elab; 221 end Has_No_Elaboration_Code; 222 223 ------------------------------- 224 -- Hash_Invocation_Signature -- 225 ------------------------------- 226 227 function Hash_Invocation_Signature 228 (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type 229 is 230 begin 231 pragma Assert (Present (IS_Id)); 232 233 return Bucket_Range_Type (IS_Id); 234 end Hash_Invocation_Signature; 235 236 --------------- 237 -- Hash_Unit -- 238 --------------- 239 240 function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type is 241 begin 242 pragma Assert (Present (U_Id)); 243 244 return Bucket_Range_Type (U_Id); 245 end Hash_Unit; 246 247 ---------------------- 248 -- Initialize_Units -- 249 ---------------------- 250 251 procedure Initialize_Units is 252 begin 253 Elaborable_Constructs := Signature_Sets.Create (Number_Of_Units); 254 Elaborable_Units := Unit_Sets.Create (Number_Of_Units); 255 end Initialize_Units; 256 257 ------------------------------- 258 -- Invocation_Graph_Encoding -- 259 ------------------------------- 260 261 function Invocation_Graph_Encoding 262 (U_Id : Unit_Id) return Invocation_Graph_Encoding_Kind 263 is 264 pragma Assert (Present (U_Id)); 265 266 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 267 U_ALI : ALIs_Record renames ALI.ALIs.Table (U_Rec.My_ALI); 268 269 begin 270 return U_ALI.Invocation_Graph_Encoding; 271 end Invocation_Graph_Encoding; 272 273 ------------------------------- 274 -- Is_Dynamically_Elaborated -- 275 ------------------------------- 276 277 function Is_Dynamically_Elaborated (U_Id : Unit_Id) return Boolean is 278 pragma Assert (Present (U_Id)); 279 280 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 281 282 begin 283 return U_Rec.Dynamic_Elab; 284 end Is_Dynamically_Elaborated; 285 286 ---------------------- 287 -- Is_Internal_Unit -- 288 ---------------------- 289 290 function Is_Internal_Unit (U_Id : Unit_Id) return Boolean is 291 pragma Assert (Present (U_Id)); 292 293 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 294 295 begin 296 return U_Rec.Internal; 297 end Is_Internal_Unit; 298 299 ------------------------ 300 -- Is_Predefined_Unit -- 301 ------------------------ 302 303 function Is_Predefined_Unit (U_Id : Unit_Id) return Boolean is 304 pragma Assert (Present (U_Id)); 305 306 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 307 308 begin 309 return U_Rec.Predefined; 310 end Is_Predefined_Unit; 311 312 --------------------------------- 313 -- Is_Stand_Alone_Library_Unit -- 314 --------------------------------- 315 316 function Is_Stand_Alone_Library_Unit (U_Id : Unit_Id) return Boolean is 317 pragma Assert (Present (U_Id)); 318 319 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 320 321 begin 322 return U_Rec.SAL_Interface; 323 end Is_Stand_Alone_Library_Unit; 324 325 ------------------------------ 326 -- Iterate_Elaborable_Units -- 327 ------------------------------ 328 329 function Iterate_Elaborable_Units return Elaborable_Units_Iterator is 330 begin 331 return Elaborable_Units_Iterator (Unit_Sets.Iterate (Elaborable_Units)); 332 end Iterate_Elaborable_Units; 333 334 ---------- 335 -- Name -- 336 ---------- 337 338 function Name (U_Id : Unit_Id) return Unit_Name_Type is 339 pragma Assert (Present (U_Id)); 340 341 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 342 343 begin 344 return U_Rec.Uname; 345 end Name; 346 347 ----------------------- 348 -- Needs_Elaboration -- 349 ----------------------- 350 351 function Needs_Elaboration 352 (IS_Id : Invocation_Signature_Id) return Boolean 353 is 354 begin 355 pragma Assert (Present (IS_Id)); 356 357 return Signature_Sets.Contains (Elaborable_Constructs, IS_Id); 358 end Needs_Elaboration; 359 360 ----------------------- 361 -- Needs_Elaboration -- 362 ----------------------- 363 364 function Needs_Elaboration (U_Id : Unit_Id) return Boolean is 365 begin 366 pragma Assert (Present (U_Id)); 367 368 return Unit_Sets.Contains (Elaborable_Units, U_Id); 369 end Needs_Elaboration; 370 371 ---------- 372 -- Next -- 373 ---------- 374 375 procedure Next 376 (Iter : in out Elaborable_Units_Iterator; 377 U_Id : out Unit_Id) 378 is 379 begin 380 Unit_Sets.Next (Unit_Sets.Iterator (Iter), U_Id); 381 end Next; 382 383 -------------------------------- 384 -- Number_Of_Elaborable_Units -- 385 -------------------------------- 386 387 function Number_Of_Elaborable_Units return Natural is 388 begin 389 return Unit_Sets.Size (Elaborable_Units); 390 end Number_Of_Elaborable_Units; 391 392 --------------------- 393 -- Number_Of_Units -- 394 --------------------- 395 396 function Number_Of_Units return Natural is 397 begin 398 return Natural (ALI.Units.Last) - Natural (ALI.Units.First) + 1; 399 end Number_Of_Units; 400 401 ---------------------------------- 402 -- Process_Invocation_Construct -- 403 ---------------------------------- 404 405 procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id) is 406 pragma Assert (Present (IC_Id)); 407 408 IS_Id : constant Invocation_Signature_Id := Signature (IC_Id); 409 410 pragma Assert (Present (IS_Id)); 411 412 begin 413 Signature_Sets.Insert (Elaborable_Constructs, IS_Id); 414 end Process_Invocation_Construct; 415 416 ----------------------------------- 417 -- Process_Invocation_Constructs -- 418 ----------------------------------- 419 420 procedure Process_Invocation_Constructs (U_Id : Unit_Id) is 421 pragma Assert (Present (U_Id)); 422 423 U_Rec : Unit_Record renames ALI.Units.Table (U_Id); 424 425 begin 426 for IC_Id in U_Rec.First_Invocation_Construct .. 427 U_Rec.Last_Invocation_Construct 428 loop 429 Process_Invocation_Construct (IC_Id); 430 end loop; 431 end Process_Invocation_Constructs; 432 433 ------------------ 434 -- Process_Unit -- 435 ------------------ 436 437 procedure Process_Unit (U_Id : Unit_Id) is 438 begin 439 pragma Assert (Present (U_Id)); 440 441 -- A stand-alone library unit must not be elaborated as part of the 442 -- current compilation because the library already carries its own 443 -- elaboration code. 444 445 if Is_Stand_Alone_Library_Unit (U_Id) then 446 null; 447 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. 451 452 else 453 Unit_Sets.Insert (Elaborable_Units, U_Id); 454 Process_Invocation_Constructs (U_Id); 455 end if; 456 end Process_Unit; 457 458end Bindo.Units; 459