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