1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- L I B -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1992-2019, 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. -- 17-- -- 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. -- 21-- -- 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/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This package contains routines for accessing and outputting the library 33-- information. It contains the routine to load subsidiary units. 34 35with Alloc; 36with Namet; use Namet; 37with Table; 38with Types; use Types; 39 40with GNAT.HTable; 41 42package Lib is 43 44 type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type; 45 -- Type to hold list of indirect references to unit number table 46 47 type Compiler_State_Type is (Parsing, Analyzing); 48 Compiler_State : Compiler_State_Type; 49 -- Indicates current state of compilation. This is used to implement the 50 -- function In_Extended_Main_Source_Unit. 51 52 Parsing_Main_Extended_Source : Boolean := False; 53 -- Set True if we are currently parsing a file that is part of the main 54 -- extended source (the main unit, its spec, or one of its subunits). This 55 -- flag to implement In_Extended_Main_Source_Unit. 56 57 Analysing_Subunit_Of_Main : Boolean := False; 58 -- Set to True when analyzing a subunit of the main source. When True, if 59 -- the subunit is preprocessed and -gnateG is specified, then the 60 -- preprocessed file (.prep) is written. 61 62 -------------------------------------------- 63 -- General Approach to Library Management -- 64 -------------------------------------------- 65 66 -- As described in GNote #1, when a unit is compiled, all its subsidiary 67 -- units are recompiled, including the following: 68 69 -- (a) Corresponding spec for a body 70 -- (b) Parent spec of a child library spec 71 -- (c) With'ed specs 72 -- (d) Parent body of a subunit 73 -- (e) Subunits corresponding to any specified stubs 74 -- (f) Bodies of inlined subprograms that are called 75 -- (g) Bodies of generic subprograms or packages that are instantiated 76 -- (h) Bodies of packages containing either of the above two items 77 -- (i) Specs and bodies of runtime units 78 -- (j) Parent specs for with'ed child library units 79 80 -- If a unit is being compiled only for syntax checking, then no subsidiary 81 -- units are loaded, the syntax check applies only to the main unit, 82 -- i.e. the one contained in the source submitted to the library. 83 84 -- If a unit is being compiled for syntax and semantic checking, then only 85 -- cases (a)-(d) loads are performed, since the full semantic checking can 86 -- be carried out without needing (e)-(i) loads. In this case no object 87 -- file, or library information file, is generated, so the missing units 88 -- do not affect the results. 89 90 -- Specifications of library subprograms, subunits, and generic specs 91 -- and bodies, can only be compiled in syntax/semantic checking mode, 92 -- since no code is ever generated directly for these units. In the case 93 -- of subunits, only the compilation of the ultimate parent unit generates 94 -- actual code. If a subunit is submitted to the compiler in syntax/ 95 -- semantic checking mode, the parent (or parents in the nested case) are 96 -- semantically checked only up to the point of the corresponding stub. 97 98 -- If code is being generated, then all the above units are required, 99 -- although the need for bodies of inlined procedures can be suppressed 100 -- by the use of a switch that sets the mode to ignore pragma Inline 101 -- statements. 102 103 -- The two main sections of the front end, Par and Sem, are recursive. 104 -- Compilation proceeds unit by unit making recursive calls as necessary. 105 -- The process is controlled from the GNAT main program, which makes calls 106 -- to Par and Sem sequence for the main unit. 107 108 -- Par parses the given unit, and then, after the parse is complete, uses 109 -- the Par.Load subprogram to load all its subsidiary units in categories 110 -- (a)-(d) above, installing pointers to the loaded units in the parse 111 -- tree, as described in a later section of this spec. If any of these 112 -- required units is missing, a fatal error is signalled, so that no 113 -- attempt is made to run Sem in such cases, since it is assumed that 114 -- too many cascaded errors would result, and the confusion would not 115 -- be helpful. 116 117 -- Following the call to Par on the main unit, the entire tree of required 118 -- units is thus loaded, and Sem is called on the main unit. The parameter 119 -- passed to Sem is the unit to be analyzed. The visibility table, which 120 -- is a single global structure, starts out containing only the entries 121 -- for the visible entities in Standard. Every call to Sem establishes a 122 -- new scope stack table, pushing an entry for Standard on entry to provide 123 -- the proper initial scope environment. 124 125 -- Sem first proceeds to perform semantic analysis on the currently loaded 126 -- units as follows: 127 128 -- In the case of a body (case (a) above), Sem analyzes the corresponding 129 -- spec, using a recursive call to Sem. As is always expected to be the 130 -- case with calls to Sem, any entities installed in the visibility table 131 -- are removed on exit from Sem, so that these entities have to be 132 -- reinstalled on return to continue the analysis of the body which of 133 -- course needs visibility of these entities. 134 -- 135 -- In the case of the parent of a child spec (case (b) above), a similar 136 -- call is made to Sem to analyze the parent. Again, on return, the 137 -- entities from the analyzed parent spec have to be installed in the 138 -- visibility table of the caller (the child unit), which must have 139 -- visibility to the entities in its parent spec. 140 141 -- For with'ed specs (case (c) above), a recursive call to Sem is made 142 -- to analyze each spec in turn. After all the spec's have been analyzed, 143 -- but not till that point, the entities from all the with'ed units are 144 -- reinstalled in the visibility table so that the caller can proceed 145 -- with the analysis of the unit doing the with's with the necessary 146 -- entities made either potentially use visible or visible by selection 147 -- as needed. 148 149 -- Case (d) arises when Sem is passed a subunit to analyze. This means 150 -- that the main unit is a subunit, and the unit passed to Sem is either 151 -- the main unit, or one of its ancestors that is still a subunit. Since 152 -- analysis must start at the top of the tree, Sem essentially cancels 153 -- the current call by immediately making a call to analyze the parent 154 -- (when this call is finished it immediately returns, so logically this 155 -- call is like a goto). The subunit will then be analyzed at the proper 156 -- time as described for the stub case. Note that we also turn off the 157 -- indication that code should be generated in this case, since the only 158 -- time we generate code for subunits is when compiling the main parent. 159 160 -- Case (e), subunits corresponding to stubs, are handled as the stubs 161 -- are encountered. There are three sub-cases: 162 163 -- If the subunit has already been loaded, then this means that the 164 -- main unit was a subunit, and we are back on our way down to it 165 -- after following the initial processing described for case (d). 166 -- In this case we analyze this particular subunit, as described 167 -- for the case where we are generating code, but when we get back 168 -- we are all done, since the rest of the parent is irrelevant. To 169 -- get out of the parent, we raise the exception Subunit_Found, which 170 -- is handled at the outer level of Sem. 171 172 -- The cases where the subunit has not already been loaded correspond 173 -- to cases where the main unit was a parent. In this case the action 174 -- depends on whether or not we are generating code. If we are not 175 -- generating code, then this is the case where we can simply ignore 176 -- the subunit, since in checking mode we don't even want to insist 177 -- that the subunit exist, much less waste time checking it. 178 179 -- If we are generating code, then we need to load and analyze 180 -- all subunits. This is achieved with a call to Lib.Load to load 181 -- and parse the unit, followed by processing that installs the 182 -- context clause of the subunit, analyzes the subunit, and then 183 -- removes the context clause (from the visibility chains of the 184 -- parent). Note that we do *not* do a recursive call to Sem in 185 -- this case, precisely because we need to do the analysis of the 186 -- subunit with the current visibility table and scope stack. 187 188 -- Case (f) applies only to subprograms for which a pragma Inline is 189 -- given, providing that the compiler is operating in the mode where 190 -- pragma Inline's are activated. When the expander encounters a call 191 -- to such a subprogram, it loads the body of the subprogram if it has 192 -- not already been loaded, and calls Sem to process it. 193 194 -- Case (g) is similar to case (f), except that the body of a generic 195 -- is unconditionally required, regardless of compiler mode settings. 196 -- As in the subprogram case, when the expander encounters a generic 197 -- instantiation, it loads the generic body of the subprogram if it 198 -- has not already been loaded, and calls Sem to process it. 199 200 -- Case (h) arises when a package contains either an inlined subprogram 201 -- which is called, or a generic which is instantiated. In this case the 202 -- body of the package must be loaded and analyzed with a call to Sem. 203 204 -- Case (i) is handled by adding implicit with clauses to the context 205 -- clauses of all units that potentially reference the relevant runtime 206 -- entities. Note that since we have the full set of units available, 207 -- the parser can always determine the set of runtime units that is 208 -- needed. These with clauses do not have associated use clauses, so 209 -- all references to the entities must be by selection. Once the with 210 -- clauses have been added, subsequent processing is as for normal 211 -- with clauses. 212 213 -- Case (j) is also handled by adding appropriate implicit with clauses 214 -- to any unit that withs a child unit. Again there is no use clause, 215 -- and subsequent processing proceeds as for an explicit with clause. 216 217 -- Sem thus completes the loading of all required units, except those 218 -- required for inline subprogram bodies or inlined generics. If any 219 -- of these load attempts fails, then the expander will not be called, 220 -- even if code was to be generated. If the load attempts all succeed 221 -- then the expander is called, though the attempt to generate code may 222 -- still fail if an error occurs during a load attempt for an inlined 223 -- body or a generic body. 224 225 ------------------------------------------- 226 -- Special Handling of Subprogram Bodies -- 227 ------------------------------------------- 228 229 -- A subprogram body (in an adb file) may stand for both a spec and a body. 230 -- A simple model (and one that was adopted through version 2.07) is simply 231 -- to assume that such an adb file acts as its own spec if no ads file is 232 -- is present. 233 234 -- However, this is not correct. RM 10.1.4(4) requires that such a body 235 -- act as a spec unless a subprogram declaration of the same name is 236 -- already present. The correct interpretation of this in GNAT library 237 -- terms is to ignore an existing ads file of the same name unless this 238 -- ads file contains a subprogram declaration with the same name. 239 240 -- If there is an ads file with a unit other than a subprogram declaration 241 -- with the same name, then a fatal message is output, noting that this 242 -- irrelevant file must be deleted before the body can be compiled. See 243 -- ACVC test CA1020D to see how this processing is required. 244 245 ----------------- 246 -- Global Data -- 247 ----------------- 248 249 Current_Sem_Unit : Unit_Number_Type := Main_Unit; 250 -- Unit number of unit currently being analyzed/expanded. This is set when 251 -- ever a new unit is entered, saving and restoring the old value, so that 252 -- it always reflects the unit currently being analyzed. The initial value 253 -- of Main_Unit ensures that a proper value is set initially, and in 254 -- particular for analysis of configuration pragmas in gnat.adc. 255 256 Main_Unit_Entity : Entity_Id; 257 -- Entity of main unit, same as Cunit_Entity (Main_Unit) except where 258 -- Main_Unit is a body with a separate spec, in which case it is the 259 -- entity for the spec. 260 261 ----------------- 262 -- Units Table -- 263 ----------------- 264 265 -- The units table has an entry for each unit (source file) read in by the 266 -- current compilation. The table is indexed by the unit number value. 267 -- The first entry in the table, subscript Main_Unit, is for the main file. 268 -- Each entry in this units table contains the following data. 269 270 -- Cunit 271 -- Pointer to the N_Compilation_Unit node. Initially set to Empty by 272 -- Lib.Load, and then reset to the required node by the parser when 273 -- the unit is parsed. 274 275 -- Cunit_Entity 276 -- Pointer to the entity node for the compilation unit. Initially set 277 -- to Empty by Lib.Load, and then reset to the required entity by the 278 -- parser when the unit is parsed. 279 280 -- Dependency_Num 281 -- This is the number of the unit within the generated dependency 282 -- lines (D lines in the ALI file) which are sorted into alphabetical 283 -- order. The number is ones origin, so a value of 2 refers to the 284 -- second generated D line. The Dependency_Num values are set as the 285 -- D lines are generated, and are used to generate proper unit 286 -- references in the generated xref information and SCO output. 287 288 -- Dynamic_Elab 289 -- A flag indicating if this unit was compiled with dynamic elaboration 290 -- checks specified (as the result of using the -gnatE compilation 291 -- option or a pragma Elaboration_Checks (Dynamic)). 292 293 -- Error_Location 294 -- This is copied from the Sloc field of the Enode argument passed 295 -- to Load_Unit. It refers to the enclosing construct which caused 296 -- this unit to be loaded, e.g. most typically the with clause that 297 -- referenced the unit, and is used for error handling in Par.Load. 298 299 -- Expected_Unit 300 -- This is the expected unit name for a file other than the main unit, 301 -- since these are cases where we load the unit using Lib.Load and we 302 -- know the unit that is expected. It must be the same as Unit_Name 303 -- if it is set (see test in Par.Load). Expected_Unit is set to 304 -- No_Name for the main unit. 305 306 -- Fatal_Error 307 -- A flag that is initialized to None and gets set to Error if a fatal 308 -- error occurs during the processing of a unit. A fatal error is one 309 -- defined as serious enough to stop the next phase of the compiler 310 -- from running (i.e. fatal error during parsing stops semantics, 311 -- fatal error during semantics stops code generation). Note that 312 -- currently, errors of any kind cause Fatal_Error to be set, but 313 -- eventually perhaps only errors labeled as fatal errors should be 314 -- this severe if we decide to try Sem on sources with minor errors. 315 -- There are three settings (see declaration of Fatal_Type). 316 317 -- Generate_Code 318 -- This flag is set True for all units in the current file for which 319 -- code is to be generated. This includes the unit explicitly compiled, 320 -- together with its specification, and any subunits. 321 322 -- Has_RACW 323 -- A Boolean flag, initially set to False when a unit entry is created, 324 -- and set to True if the unit defines a remote access to class wide 325 -- (RACW) object. This is used for controlling generation of the RA 326 -- attribute in the ali file. 327 328 -- Ident_String 329 -- N_String_Literal node from a valid pragma Ident that applies to 330 -- this unit. If no Ident pragma applies to the unit, then Empty. 331 332 -- Is_Predefined_Renaming 333 -- True if this unit is a predefined renaming, as in "Text_IO renames 334 -- Ada.Text_IO"). 335 336 -- Is_Internal_Unit 337 -- Same as In_Predefined_Unit, except units in the GNAT hierarchy are 338 -- included. 339 340 -- Is_Predefined_Unit 341 -- True if this unit is predefined (i.e. part of the Ada, System, or 342 -- Interface hierarchies, or Is_Predefined_Renaming). Note that units 343 -- in the GNAT hierarchy are not considered predefined. 344 345 -- Loading 346 -- A flag that is used to catch circular WITH dependencies. It is set 347 -- True when an entry is initially created in the file table, and set 348 -- False when the load is completed, or ends with an error. 349 350 -- Main_Priority 351 -- This field is used to indicate the priority of a possible main 352 -- program, as set by a pragma Priority. A value of -1 indicates 353 -- that the default priority is to be used (and is also used for 354 -- entries that do not correspond to possible main programs). 355 356 -- Main_CPU 357 -- This field is used to indicate the affinity of a possible main 358 -- program, as set by a pragma CPU. A value of -1 indicates 359 -- that the default affinity is to be used (and is also used for 360 -- entries that do not correspond to possible main programs). 361 362 -- Munit_Index 363 -- The index of the unit within the file for multiple unit per file 364 -- mode. Set to zero in normal single unit per file mode. 365 366 -- No_Elab_Code_All 367 -- A flag set when a pragma or aspect No_Elaboration_Code_All applies 368 -- to the unit. This is used to implement the transitive WITH rules 369 -- (and for no other purpose). 370 371 -- OA_Setting 372 -- This is a character field containing L if Optimize_Alignment mode 373 -- was set locally, and O/T/S for Off/Time/Space default if not. 374 375 -- Primary_Stack_Count 376 -- The number of primary stacks belonging to tasks defined within the 377 -- unit that have no Storage_Size specified when the either restriction 378 -- No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations is 379 -- active. Only used by the binder to generate stacks for these tasks 380 -- at bind time. 381 382 -- Sec_Stack_Count 383 -- The number of secondary stacks belonging to tasks defined within the 384 -- unit that have no Secondary_Stack_Size specified when the either 385 -- the No_Implicit_Heap_Allocations or No_Implicit_Task_Allocations 386 -- restrictions are active. Only used by the binder to generate stacks 387 -- for these tasks at bind time. 388 389 -- Serial_Number 390 -- This field holds a serial number used by New_Internal_Name to 391 -- generate unique temporary numbers on a unit by unit basis. The 392 -- only access to this field is via the Increment_Serial_Number 393 -- routine which increments the current value and returns it. This 394 -- serial number is separate for each unit. 395 396 -- Source_Index 397 -- The index in the source file table of the corresponding source file. 398 -- Set when the entry is created by a call to Lib.Load and then cannot 399 -- be changed. 400 401 -- Unit_File_Name 402 -- The name of the source file containing the unit. Set when the entry 403 -- is created by a call to Lib.Load, and then cannot be changed. 404 405 -- Unit_Name 406 -- The name of the unit. Initialized to No_Name by Lib.Load, and then 407 -- set by the parser when the unit is parsed to the unit name actually 408 -- found in the file (which should, in the absence of errors) be the 409 -- same name as Expected_Unit. 410 411 -- Version 412 -- This field holds the version of the unit, which is computed as 413 -- the exclusive or of the checksums of this unit, and all its 414 -- semantically dependent units. Access to the version number field 415 -- is not direct, but is done through the routines described below. 416 -- When a unit table entry is created, this field is initialized to 417 -- the checksum of the corresponding source file. Version_Update is 418 -- then called to reflect the contributions of any unit on which this 419 -- unit is semantically dependent. 420 421 -- The units table is reset to empty at the start of the compilation of 422 -- each main unit by Lib.Initialize. Entries are then added by calls to 423 -- the Lib.Load procedure. The following subprograms are used to access 424 -- and modify entries in the Units table. Individual entries are accessed 425 -- using a unit number value which ranges from Main_Unit (the first entry, 426 -- which is always for the current main unit) to Last_Unit. 427 428 Default_Main_Priority : constant Int := -1; 429 -- Value used in Main_Priority field to indicate default main priority 430 431 Default_Main_CPU : constant Int := -1; 432 -- Value used in Main_CPU field to indicate default main affinity 433 434 -- The following defines settings for the Fatal_Error field 435 436 type Fatal_Type is ( 437 None, 438 -- No error detected for this unit 439 440 Error_Detected, 441 -- Fatal error detected that prevents moving to the next phase. For 442 -- example, a fatal error during parsing inhibits semantic analysis. 443 444 Error_Ignored); 445 -- A fatal error was detected, but we are in Try_Semantics mode (as set 446 -- by -gnatq or -gnatQ). This does not stop the compiler from proceding, 447 -- but tools can use this status (e.g. ASIS looking at the generated 448 -- tree) to know that a fatal error was detected. 449 450 function Cunit (U : Unit_Number_Type) return Node_Id; 451 function Cunit_Entity (U : Unit_Number_Type) return Entity_Id; 452 function Dependency_Num (U : Unit_Number_Type) return Nat; 453 function Dynamic_Elab (U : Unit_Number_Type) return Boolean; 454 function Error_Location (U : Unit_Number_Type) return Source_Ptr; 455 function Expected_Unit (U : Unit_Number_Type) return Unit_Name_Type; 456 function Fatal_Error (U : Unit_Number_Type) return Fatal_Type; 457 function Generate_Code (U : Unit_Number_Type) return Boolean; 458 function Ident_String (U : Unit_Number_Type) return Node_Id; 459 function Has_RACW (U : Unit_Number_Type) return Boolean; 460 function Is_Predefined_Renaming 461 (U : Unit_Number_Type) return Boolean; 462 function Is_Internal_Unit (U : Unit_Number_Type) return Boolean; 463 function Is_Predefined_Unit 464 (U : Unit_Number_Type) return Boolean; 465 function Loading (U : Unit_Number_Type) return Boolean; 466 function Main_CPU (U : Unit_Number_Type) return Int; 467 function Main_Priority (U : Unit_Number_Type) return Int; 468 function Munit_Index (U : Unit_Number_Type) return Nat; 469 function No_Elab_Code_All (U : Unit_Number_Type) return Boolean; 470 function OA_Setting (U : Unit_Number_Type) return Character; 471 function Primary_Stack_Count 472 (U : Unit_Number_Type) return Int; 473 function Sec_Stack_Count (U : Unit_Number_Type) return Int; 474 function Source_Index (U : Unit_Number_Type) return Source_File_Index; 475 function Unit_File_Name (U : Unit_Number_Type) return File_Name_Type; 476 function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type; 477 -- Get value of named field from given units table entry 478 479 -- WARNING: There is a matching C declaration of a few subprograms in fe.h 480 481 procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id); 482 procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id); 483 procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True); 484 procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr); 485 procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type); 486 procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True); 487 procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True); 488 procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id); 489 procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True); 490 procedure Set_Main_CPU (U : Unit_Number_Type; P : Int); 491 procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True); 492 procedure Set_Main_Priority (U : Unit_Number_Type; P : Int); 493 procedure Set_OA_Setting (U : Unit_Number_Type; C : Character); 494 procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type); 495 -- Set value of named field for given units table entry. Note that we 496 -- do not have an entry for each possible field, since some of the fields 497 -- can only be set by specialized interfaces (defined below). 498 499 function Compilation_Switches_Last return Nat; 500 -- Return the count of stored compilation switches 501 502 procedure Disable_Switch_Storing; 503 -- Disable registration of switches by Store_Compilation_Switch. Used to 504 -- avoid registering switches added automatically by the gcc driver at the 505 -- end of the command line. 506 507 function Earlier_In_Extended_Unit 508 (S1 : Source_Ptr; 509 S2 : Source_Ptr) return Boolean; 510 -- Given two Sloc values for which In_Same_Extended_Unit is true, determine 511 -- if S1 appears before S2. Returns True if S1 appears before S2, and False 512 -- otherwise. The result is undefined if S1 and S2 are not in the same 513 -- extended unit. Note: this routine will not give reliable results if 514 -- called after Sprint has been called with -gnatD set. 515 516 function Earlier_In_Extended_Unit 517 (N1 : Node_Or_Entity_Id; 518 N2 : Node_Or_Entity_Id) return Boolean; 519 -- Same as above, but the inputs denote nodes or entities 520 521 procedure Enable_Switch_Storing; 522 -- Enable registration of switches by Store_Compilation_Switch. Used to 523 -- avoid registering switches added automatically by the gcc driver at the 524 -- beginning of the command line. 525 526 function Entity_Is_In_Main_Unit (E : Entity_Id) return Boolean; 527 -- Returns True if the entity E is declared in the main unit, or, in 528 -- its corresponding spec, or one of its subunits. Entities declared 529 -- within generic instantiations return True if the instantiation is 530 -- itself "in the main unit" by this definition. Otherwise False. 531 532 function Exact_Source_Name (Loc : Source_Ptr) return String; 533 -- Return name of entity at location Loc exactly as written in the source. 534 -- This includes copying the wide character encodings exactly as they were 535 -- used in the source, so the caller must be aware of the possibility of 536 -- such encodings. 537 538 function Get_Compilation_Switch (N : Pos) return String_Ptr; 539 -- Return the Nth stored compilation switch, or null if less than N 540 -- switches have been stored. Used by ASIS and back ends written in Ada. 541 542 function Generic_May_Lack_ALI (Unum : Unit_Number_Type) return Boolean; 543 -- Generic units must be separately compiled. Since we always use 544 -- macro substitution for generics, the resulting object file is a dummy 545 -- one with no code, but the ALI file has the normal form, and we need 546 -- this ALI file so that the binder can work out a correct order of 547 -- elaboration. 548 -- 549 -- However, ancient versions of GNAT used to not generate code or ALI 550 -- files for generic units, and this would yield complex order of 551 -- elaboration issues. These were fixed in GNAT 3.10. The support for not 552 -- compiling language-defined library generics was retained nonetheless 553 -- to facilitate bootstrap. Specifically, it is convenient to have 554 -- the same list of files to be compiled for all stages. So, if the 555 -- bootstrap compiler does not generate code for a given file, then 556 -- the stage1 compiler (and binder) also must deal with the case of 557 -- that file not being compiled. The predicate Generic_May_Lack_ALI is 558 -- True for those generic units for which missing ALI files are allowed. 559 560 function Get_Cunit_Unit_Number (N : Node_Id) return Unit_Number_Type; 561 -- Return unit number of the unit whose N_Compilation_Unit node is the 562 -- one passed as an argument. This must always succeed since the node 563 -- could not have been built without making a unit table entry. 564 565 function Get_Cunit_Entity_Unit_Number 566 (E : Entity_Id) return Unit_Number_Type; 567 -- Return unit number of the unit whose compilation unit spec entity is 568 -- the one passed as an argument. This must always succeed since the 569 -- entity could not have been built without making a unit table entry. 570 571 function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type; 572 pragma Inline (Get_Source_Unit); 573 function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type; 574 -- Return unit number of file identified by given source pointer value. 575 -- This call must always succeed, since any valid source pointer value 576 -- belongs to some previously loaded module. If the given source pointer 577 -- value is within an instantiation, this function returns the unit number 578 -- of the template, i.e. the unit containing the source code corresponding 579 -- to the given Source_Ptr value. The version taking a Node_Id argument, N, 580 -- simply applies the function to Sloc (N). 581 582 function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type; 583 pragma Inline (Get_Code_Unit); 584 function Get_Code_Unit (S : Source_Ptr) return Unit_Number_Type; 585 -- This is like Get_Source_Unit, except that in the instantiation case, 586 -- it uses the location of the top level instantiation, rather than the 587 -- template, so it returns the unit number containing the code that 588 -- corresponds to the node N, or the source location S. 589 590 function Get_Top_Level_Code_Unit 591 (N : Node_Or_Entity_Id) return Unit_Number_Type; 592 pragma Inline (Get_Code_Unit); 593 function Get_Top_Level_Code_Unit (S : Source_Ptr) return Unit_Number_Type; 594 -- This is like Get_Code_Unit, except that in the case of subunits, it 595 -- returns the top-level unit to which the subunit belongs instead of 596 -- the subunit. 597 -- 598 -- Note: for nodes and slocs in declarations of library-level instances of 599 -- generics these routines wrongly return the unit number corresponding to 600 -- the body of the instance. In effect, locations of SPARK references in 601 -- ALI files are bogus. However, fixing this is not worth the effort, since 602 -- these references are only used for debugging. 603 604 function In_Extended_Main_Code_Unit 605 (N : Node_Or_Entity_Id) return Boolean; 606 -- Return True if the node is in the generated code of the extended main 607 -- unit, defined as the main unit, its specification (if any), and all 608 -- its subunits (considered recursively). Units for which this enquiry 609 -- returns True are those for which code will be generated. Nodes from 610 -- instantiations are included in the extended main unit for this call. 611 -- If the main unit is itself a subunit, then the extended main code unit 612 -- includes its parent unit, and the parent unit spec if it is separate. 613 -- 614 -- This routine (and the following three routines) all return False if 615 -- Sloc (N) is No_Location or Standard_Location. In an earlier version, 616 -- they returned True for Standard_Location, but this was odd, and some 617 -- archeology indicated that this was done for the sole benefit of the 618 -- call in Restrict.Check_Restriction_No_Dependence, so we have moved 619 -- the special case check to that routine. This avoids some difficulties 620 -- with some other calls that malfunctioned with the odd return of True. 621 622 -- WARNING: There is a matching C declaration of this subprogram in fe.h 623 624 function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean; 625 -- Same function as above, but argument is a source pointer rather 626 -- than a node. 627 628 function In_Extended_Main_Source_Unit 629 (N : Node_Or_Entity_Id) return Boolean; 630 -- Return True if the node is in the source text of the extended main 631 -- unit, defined as the main unit, its specification (if any), and all 632 -- its subunits (considered recursively). Units for which this enquiry 633 -- returns True are those for which code will be generated. This differs 634 -- from In_Extended_Main_Code_Unit only in that instantiations are not 635 -- included for the purposes of this call. If the main unit is itself 636 -- a subunit, then the extended main source unit includes its parent unit, 637 -- and the parent unit spec if it is separate. 638 639 function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean; 640 -- Same function as above, but argument is a source pointer 641 642 function In_Predefined_Unit (N : Node_Or_Entity_Id) return Boolean; 643 -- Returns True if the given node or entity appears within the source text 644 -- of a predefined unit (i.e. within Ada, Interfaces, System or within one 645 -- of the descendant packages of one of these three packages). 646 647 function In_Predefined_Unit (S : Source_Ptr) return Boolean; 648 pragma Inline (In_Predefined_Unit); 649 -- Same function as above but argument is a source pointer 650 651 function In_Internal_Unit (N : Node_Or_Entity_Id) return Boolean; 652 function In_Internal_Unit (S : Source_Ptr) return Boolean; 653 pragma Inline (In_Internal_Unit); 654 -- Same as In_Predefined_Unit, except units in the GNAT hierarchy are 655 -- included. 656 657 function In_Predefined_Renaming (N : Node_Or_Entity_Id) return Boolean; 658 function In_Predefined_Renaming (S : Source_Ptr) return Boolean; 659 pragma Inline (In_Predefined_Renaming); 660 -- Returns True if N or S is in a predefined renaming unit 661 662 function In_Same_Code_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean; 663 pragma Inline (In_Same_Code_Unit); 664 -- Determines if the two nodes or entities N1 and N2 are in the same 665 -- code unit, the criterion being that Get_Code_Unit yields the same 666 -- value for each argument. 667 668 function In_Same_Extended_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean; 669 pragma Inline (In_Same_Extended_Unit); 670 -- Determines if two nodes or entities N1 and N2 are in the same 671 -- extended unit, where an extended unit is defined as a unit and all 672 -- its subunits (considered recursively, i.e. subunits of subunits are 673 -- included). Returns true if S1 and S2 are in the same extended unit 674 -- and False otherwise. 675 676 function In_Same_Extended_Unit (S1, S2 : Source_Ptr) return Boolean; 677 pragma Inline (In_Same_Extended_Unit); 678 -- Determines if the two source locations S1 and S2 are in the same 679 -- extended unit, where an extended unit is defined as a unit and all 680 -- its subunits (considered recursively, i.e. subunits of subunits are 681 -- included). Returns true if S1 and S2 are in the same extended unit 682 -- and False otherwise. 683 684 function In_Same_Source_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean; 685 pragma Inline (In_Same_Source_Unit); 686 -- Determines if the two nodes or entities N1 and N2 are in the same 687 -- source unit, the criterion being that Get_Source_Unit yields the 688 -- same value for each argument. 689 690 procedure Increment_Primary_Stack_Count (Increment : Int); 691 -- Increment the Primary_Stack_Count field for the current unit by 692 -- Increment. 693 694 procedure Increment_Sec_Stack_Count (Increment : Int); 695 -- Increment the Sec_Stack_Count field for the current unit by Increment 696 697 function Increment_Serial_Number return Nat; 698 -- Increment Serial_Number field for current unit, and return the 699 -- incremented value. 700 701 procedure Initialize; 702 -- Initialize internal tables 703 704 function Is_Loaded (Uname : Unit_Name_Type) return Boolean; 705 -- Determines if unit with given name is already loaded, i.e. there is 706 -- already an entry in the file table with this unit name for which the 707 -- corresponding file was found and parsed. Note that the Fatal_Error value 708 -- of this entry must be checked before proceeding with further processing. 709 710 function Last_Unit return Unit_Number_Type; 711 -- Unit number of last allocated unit 712 713 procedure List (File_Names_Only : Boolean := False); 714 -- Lists units in active library (i.e. generates output consisting of a 715 -- sorted listing of the units represented in File table, except for the 716 -- main unit). If File_Names_Only is set to True, then the list includes 717 -- only file names, and no other information. Otherwise the unit name and 718 -- time stamp are also output. File_Names_Only also restricts the list to 719 -- exclude any predefined files. 720 721 procedure Lock; 722 -- Lock internal tables before calling back end 723 724 function Num_Units return Nat; 725 -- Number of units currently in unit table 726 727 procedure Remove_Unit (U : Unit_Number_Type); 728 -- Remove unit U from unit table. Currently this is effective only if U is 729 -- the last unit currently stored in the unit table. 730 731 procedure Replace_Linker_Option_String 732 (S : String_Id; 733 Match_String : String); 734 -- Replace an existing Linker_Option if the prefix Match_String matches, 735 -- otherwise call Store_Linker_Option_String. 736 737 procedure Store_Compilation_Switch (Switch : String); 738 -- Called to register a compilation switch, either front-end or back-end, 739 -- which may influence the generated output file(s). Switch is the text of 740 -- the switch to store (except that -fRTS gets changed back to --RTS). 741 742 procedure Store_Linker_Option_String (S : String_Id); 743 -- This procedure is called to register the string from a pragma 744 -- Linker_Option. The argument is the Id of the string to register. 745 746 procedure Store_Note (N : Node_Id); 747 -- This procedure is called to register a pragma N for which a notes 748 -- entry is required. 749 750 procedure Synchronize_Serial_Number; 751 -- This function increments the Serial_Number field for the current unit 752 -- but does not return the incremented value. This is used when there 753 -- is a situation where one path of control increments a serial number 754 -- (using Increment_Serial_Number), and the other path does not and it is 755 -- important to keep the serial numbers synchronized in the two cases (e.g. 756 -- when the references in a package and a client must be kept consistent). 757 758 procedure Tree_Read; 759 -- Initializes internal tables from current tree file using the relevant 760 -- Table.Tree_Read routines. 761 762 procedure Tree_Write; 763 -- Writes out internal tables to current tree file using the relevant 764 -- Table.Tree_Write routines. 765 766 procedure Unlock; 767 -- Unlock internal tables, in cases where the back end needs to modify them 768 769 function Version_Get (U : Unit_Number_Type) return Word_Hex_String; 770 -- Returns the version as a string with 8 hex digits (upper case letters) 771 772 procedure Version_Referenced (S : String_Id); 773 -- This routine is called from Exp_Attr to register the use of a Version 774 -- or Body_Version attribute. The argument is the external name used to 775 -- access the version string. 776 777 procedure Write_Unit_Info 778 (Unit_Num : Unit_Number_Type; 779 Item : Node_Id; 780 Prefix : String := ""; 781 Withs : Boolean := False); 782 -- Print out debugging information about the unit. Prefix precedes the rest 783 -- of the printout. If Withs is True, we print out units with'ed by this 784 -- unit (not counting limited withs). 785 786 --------------------------------------------------------------- 787 -- Special Handling for Restriction_Set (No_Dependence) Case -- 788 --------------------------------------------------------------- 789 790 -- If we have a Restriction_Set attribute for No_Dependence => unit, 791 -- and the unit is not given in a No_Dependence restriction that we 792 -- can see, the attribute will return False. 793 794 -- We have to ensure in this case that the binder will reject any attempt 795 -- to set a No_Dependence restriction in some other unit in the partition. 796 797 -- If the unit is in the semantic closure, then of course it is properly 798 -- WITH'ed by someone, and the binder will do this job automatically as 799 -- part of its normal processing. 800 801 -- But if the unit is not in the semantic closure, we must make sure the 802 -- binder knows about it. The use of the Restriction_Set attribute giving 803 -- a result of False does not mean of itself that we have to include the 804 -- unit in the partition. So what we do is to generate a with (W) line in 805 -- the ali file (with no file name information), but no corresponding D 806 -- (dependency) line. This is recognized by the binder as meaning "Don't 807 -- let anyone specify No_Dependence for this unit, but you don't have to 808 -- include it if there is no real W line for the unit". 809 810 -- The following table keeps track of relevant units. It is used in the 811 -- Lib.Writ circuit for outputting With lines to output the special with 812 -- line with RA if the unit is not in the semantic closure. 813 814 package Restriction_Set_Dependences is new Table.Table ( 815 Table_Component_Type => Unit_Name_Type, 816 Table_Index_Type => Int, 817 Table_Low_Bound => 0, 818 Table_Initial => 10, 819 Table_Increment => 100, 820 Table_Name => "Restriction_Attribute_Dependences"); 821 822private 823 pragma Inline (Cunit); 824 pragma Inline (Cunit_Entity); 825 pragma Inline (Dependency_Num); 826 pragma Inline (Fatal_Error); 827 pragma Inline (Generate_Code); 828 pragma Inline (Has_RACW); 829 pragma Inline (Increment_Primary_Stack_Count); 830 pragma Inline (Increment_Sec_Stack_Count); 831 pragma Inline (Increment_Serial_Number); 832 pragma Inline (Is_Internal_Unit); 833 pragma Inline (Is_Loaded); 834 pragma Inline (Is_Predefined_Renaming); 835 pragma Inline (Is_Predefined_Unit); 836 pragma Inline (Loading); 837 pragma Inline (Main_CPU); 838 pragma Inline (Main_Priority); 839 pragma Inline (Munit_Index); 840 pragma Inline (No_Elab_Code_All); 841 pragma Inline (OA_Setting); 842 pragma Inline (Primary_Stack_Count); 843 pragma Inline (Set_Cunit); 844 pragma Inline (Set_Cunit_Entity); 845 pragma Inline (Set_Fatal_Error); 846 pragma Inline (Set_Generate_Code); 847 pragma Inline (Set_Has_RACW); 848 pragma Inline (Sec_Stack_Count); 849 pragma Inline (Set_Loading); 850 pragma Inline (Set_Main_CPU); 851 pragma Inline (Set_Main_Priority); 852 pragma Inline (Set_No_Elab_Code_All); 853 pragma Inline (Set_OA_Setting); 854 pragma Inline (Set_Unit_Name); 855 pragma Inline (Source_Index); 856 pragma Inline (Unit_File_Name); 857 pragma Inline (Unit_Name); 858 859 -- The Units Table 860 861 type Unit_Record is record 862 Unit_File_Name : File_Name_Type; 863 Unit_Name : Unit_Name_Type; 864 Munit_Index : Nat; 865 Expected_Unit : Unit_Name_Type; 866 Source_Index : Source_File_Index; 867 Cunit : Node_Id; 868 Cunit_Entity : Entity_Id; 869 Dependency_Num : Int; 870 Ident_String : Node_Id; 871 Main_Priority : Int; 872 Main_CPU : Int; 873 Primary_Stack_Count : Int; 874 Sec_Stack_Count : Int; 875 Serial_Number : Nat; 876 Version : Word; 877 Error_Location : Source_Ptr; 878 Fatal_Error : Fatal_Type; 879 Generate_Code : Boolean; 880 Has_RACW : Boolean; 881 Dynamic_Elab : Boolean; 882 No_Elab_Code_All : Boolean; 883 Filler : Boolean; 884 Loading : Boolean; 885 OA_Setting : Character; 886 887 Is_Predefined_Renaming : Boolean; 888 Is_Internal_Unit : Boolean; 889 Is_Predefined_Unit : Boolean; 890 Filler2 : Boolean; 891 end record; 892 893 -- The following representation clause ensures that the above record 894 -- has no holes. We do this so that when instances of this record are 895 -- written by Tree_Gen, we do not write uninitialized values to the file. 896 897 for Unit_Record use record 898 Unit_File_Name at 0 range 0 .. 31; 899 Unit_Name at 4 range 0 .. 31; 900 Munit_Index at 8 range 0 .. 31; 901 Expected_Unit at 12 range 0 .. 31; 902 Source_Index at 16 range 0 .. 31; 903 Cunit at 20 range 0 .. 31; 904 Cunit_Entity at 24 range 0 .. 31; 905 Dependency_Num at 28 range 0 .. 31; 906 Ident_String at 32 range 0 .. 31; 907 Main_Priority at 36 range 0 .. 31; 908 Main_CPU at 40 range 0 .. 31; 909 Primary_Stack_Count at 44 range 0 .. 31; 910 Sec_Stack_Count at 48 range 0 .. 31; 911 Serial_Number at 52 range 0 .. 31; 912 Version at 56 range 0 .. 31; 913 Error_Location at 60 range 0 .. 31; 914 Fatal_Error at 64 range 0 .. 7; 915 Generate_Code at 65 range 0 .. 7; 916 Has_RACW at 66 range 0 .. 7; 917 Dynamic_Elab at 67 range 0 .. 7; 918 No_Elab_Code_All at 68 range 0 .. 7; 919 Filler at 69 range 0 .. 7; 920 OA_Setting at 70 range 0 .. 7; 921 Loading at 71 range 0 .. 7; 922 923 Is_Predefined_Renaming at 72 range 0 .. 7; 924 Is_Internal_Unit at 73 range 0 .. 7; 925 Is_Predefined_Unit at 74 range 0 .. 7; 926 Filler2 at 75 range 0 .. 7; 927 end record; 928 929 for Unit_Record'Size use 76 * 8; 930 -- This ensures that we did not leave out any fields 931 932 package Units is new Table.Table ( 933 Table_Component_Type => Unit_Record, 934 Table_Index_Type => Unit_Number_Type, 935 Table_Low_Bound => Main_Unit, 936 Table_Initial => Alloc.Units_Initial, 937 Table_Increment => Alloc.Units_Increment, 938 Table_Name => "Units"); 939 940 -- The following table records a mapping between a name and the entry in 941 -- the units table whose Unit_Name is this name. It is used to speed up 942 -- the Is_Loaded function, whose original implementation (linear search) 943 -- could account for 2% of the time spent in the front end. Note that, in 944 -- the case of source files containing multiple units, the units table may 945 -- temporarily contain two entries with the same Unit_Name during parsing, 946 -- which means that the mapping must be to the first entry in the table. 947 948 Unit_Name_Table_Size : constant := 257; 949 -- Number of headers in hash table 950 951 subtype Unit_Name_Header_Num is Integer range 0 .. Unit_Name_Table_Size - 1; 952 -- Range of headers in hash table 953 954 function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num; 955 -- Simple hash function for Unit_Name_Types 956 957 package Unit_Names is new GNAT.Htable.Simple_HTable 958 (Header_Num => Unit_Name_Header_Num, 959 Element => Unit_Number_Type, 960 No_Element => No_Unit, 961 Key => Unit_Name_Type, 962 Hash => Unit_Name_Hash, 963 Equal => "="); 964 965 procedure Init_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type); 966 pragma Inline (Init_Unit_Name); 967 -- Both set the Unit_Name for the given units table entry and register a 968 -- mapping between this name and the entry. 969 970 -- The following table stores strings from pragma Linker_Option lines 971 972 type Linker_Option_Entry is record 973 Option : String_Id; 974 -- The string for the linker option line 975 976 Unit : Unit_Number_Type; 977 -- The unit from which the linker option comes 978 end record; 979 980 package Linker_Option_Lines is new Table.Table ( 981 Table_Component_Type => Linker_Option_Entry, 982 Table_Index_Type => Integer, 983 Table_Low_Bound => 1, 984 Table_Initial => Alloc.Linker_Option_Lines_Initial, 985 Table_Increment => Alloc.Linker_Option_Lines_Increment, 986 Table_Name => "Linker_Option_Lines"); 987 988 -- The following table stores references to pragmas that generate Notes 989 990 package Notes is new Table.Table ( 991 Table_Component_Type => Node_Id, 992 Table_Index_Type => Integer, 993 Table_Low_Bound => 1, 994 Table_Initial => Alloc.Notes_Initial, 995 Table_Increment => Alloc.Notes_Increment, 996 Table_Name => "Notes"); 997 998 -- The following table records the compilation switches used to compile 999 -- the main unit. The table includes only switches. It excludes -o 1000 -- switches as well as artifacts of the gcc/gnat1 interface such as 1001 -- -quiet, -dumpbase, or -auxbase. 1002 1003 -- This table is set as part of the compiler argument scanning in 1004 -- Back_End. It can also be reset in -gnatc mode from the data in an 1005 -- existing ali file, and is read and written by the Tree_Read and 1006 -- Tree_Write routines for ASIS. 1007 1008 package Compilation_Switches is new Table.Table ( 1009 Table_Component_Type => String_Ptr, 1010 Table_Index_Type => Nat, 1011 Table_Low_Bound => 1, 1012 Table_Initial => 30, 1013 Table_Increment => 100, 1014 Table_Name => "Compilation_Switches"); 1015 1016 Load_Msg_Sloc : Source_Ptr; 1017 -- Location for placing error messages (a token in the main source text) 1018 -- This is set from Sloc (Enode) by Load only in the case where this Sloc 1019 -- is in the main source file. This ensures that not found messages and 1020 -- circular dependency messages reference the original with in this source. 1021 1022 type Load_Stack_Entry is record 1023 Unit_Number : Unit_Number_Type; 1024 With_Node : Node_Id; 1025 end record; 1026 1027 -- The Load_Stack table contains a list of unit numbers (indexes into the 1028 -- unit table) of units being loaded on a single dependency chain, and a 1029 -- flag to indicate whether this unit is loaded through a limited_with 1030 -- clause. The First entry is the main unit. The second entry, if present 1031 -- is a unit on which the first unit depends, etc. This stack is used to 1032 -- generate error messages showing the dependency chain if a file is not 1033 -- found, or whether a true circular dependency exists. The Load_Unit 1034 -- function makes an entry in this table when it is called, and removes 1035 -- the entry just before it returns. 1036 1037 package Load_Stack is new Table.Table ( 1038 Table_Component_Type => Load_Stack_Entry, 1039 Table_Index_Type => Int, 1040 Table_Low_Bound => 0, 1041 Table_Initial => Alloc.Load_Stack_Initial, 1042 Table_Increment => Alloc.Load_Stack_Increment, 1043 Table_Name => "Load_Stack"); 1044 1045 procedure Sort (Tbl : in out Unit_Ref_Table); 1046 -- This procedure sorts the given unit reference table in order of 1047 -- ascending unit names, where the ordering relation is as described 1048 -- by the comparison routines provided by package Uname. 1049 1050 -- The Version_Ref table records Body_Version and Version attribute 1051 -- references. The entries are simply the strings for the external 1052 -- names that correspond to the referenced values. 1053 1054 package Version_Ref is new Table.Table ( 1055 Table_Component_Type => String_Id, 1056 Table_Index_Type => Nat, 1057 Table_Low_Bound => 1, 1058 Table_Initial => 20, 1059 Table_Increment => 100, 1060 Table_Name => "Version_Ref"); 1061 1062end Lib; 1063