gcc/ada/bindo-units.adb

   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-2023, 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
  26 with Bindo.Writers;
  27 use  Bindo.Writers;
  28 use  Bindo.Writers.Phase_Writers;
  29
  30 package 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
 458 end Bindo.Units;