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