1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Butil; use Butil;
27 with Debug; use Debug;
28 with Fname; use Fname;
30 with Osint; use Osint;
31 with Output; use Output;
32 with Snames; use Snames;
35 with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
40 -- Make control characters visible
46 -- The following type represents an invocation construct
48 type Invocation_Construct_Record is record
49 Body_Placement : Declaration_Placement_Kind := No_Declaration_Placement;
50 -- The location of the invocation construct's body with respect to the
51 -- unit where it is declared.
53 Kind : Invocation_Construct_Kind := Regular_Construct;
54 -- The nature of the invocation construct
56 Signature : Invocation_Signature_Id := No_Invocation_Signature;
57 -- The invocation signature that uniquely identifies the invocation
58 -- construct in the ALI space.
60 Spec_Placement : Declaration_Placement_Kind := No_Declaration_Placement;
61 -- The location of the invocation construct's spec with respect to the
62 -- unit where it is declared.
65 -- The following type represents an invocation relation. It associates an
66 -- invoker that activates/calls/instantiates with a target.
68 type Invocation_Relation_Record is record
69 Extra : Name_Id := No_Name;
70 -- The name of an additional entity used in error diagnostics
72 Invoker : Invocation_Signature_Id := No_Invocation_Signature;
73 -- The invocation signature that uniquely identifies the invoker within
76 Kind : Invocation_Kind := No_Invocation;
77 -- The nature of the invocation
79 Target : Invocation_Signature_Id := No_Invocation_Signature;
80 -- The invocation signature that uniquely identifies the target within
84 -- The following type represents an invocation signature. Its purpose is
85 -- to uniquely identify an invocation construct within the ALI space. The
86 -- signature comprises several pieces, some of which are used in error
87 -- diagnostics by the binder. Identification issues are resolved as
90 -- * The Column, Line, and Locations attributes together differentiate
91 -- between homonyms. In most cases, the Column and Line are sufficient
92 -- except when generic instantiations are involved. Together, the three
93 -- attributes offer a sequence of column-line pairs that eventually
94 -- reflect the location within the generic template.
96 -- * The Name attribute differentiates between invocation constructs at
97 -- the scope level. Since it is illegal for two entities with the same
98 -- name to coexist in the same scope, the Name attribute is sufficient
99 -- to distinguish them. Overloaded entities are already handled by the
100 -- Column, Line, and Locations attributes.
102 -- * The Scope attribute differentiates between invocation constructs at
103 -- various levels of nesting.
105 type Invocation_Signature_Record is record
107 -- The column number where the invocation construct is declared
110 -- The line number where the invocation construct is declared
112 Locations : Name_Id := No_Name;
113 -- Sequence of column and line numbers within nested instantiations
115 Name : Name_Id := No_Name;
116 -- The name of the invocation construct
118 Scope : Name_Id := No_Name;
119 -- The qualified name of the scope where the invocation construct is
123 ---------------------
124 -- Data structures --
125 ---------------------
127 package Invocation_Constructs is new Table.Table
128 (Table_Index_Type => Invocation_Construct_Id,
129 Table_Component_Type => Invocation_Construct_Record,
130 Table_Low_Bound => First_Invocation_Construct,
131 Table_Initial => 2500,
132 Table_Increment => 200,
133 Table_Name => "Invocation_Constructs");
135 package Invocation_Relations is new Table.Table
136 (Table_Index_Type => Invocation_Relation_Id,
137 Table_Component_Type => Invocation_Relation_Record,
138 Table_Low_Bound => First_Invocation_Relation,
139 Table_Initial => 2500,
140 Table_Increment => 200,
141 Table_Name => "Invocation_Relation");
143 package Invocation_Signatures is new Table.Table
144 (Table_Index_Type => Invocation_Signature_Id,
145 Table_Component_Type => Invocation_Signature_Record,
146 Table_Low_Bound => First_Invocation_Signature,
147 Table_Initial => 2500,
148 Table_Increment => 200,
149 Table_Name => "Invocation_Signatures");
151 procedure Destroy (IS_Id : in out Invocation_Signature_Id);
152 -- Destroy an invocation signature with id IS_Id
155 (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type;
156 -- Obtain the hash of key IS_Rec
158 package Sig_Map is new Dynamic_Hash_Tables
159 (Key_Type => Invocation_Signature_Record,
160 Value_Type => Invocation_Signature_Id,
161 No_Value => No_Invocation_Signature,
162 Expansion_Threshold => 1.5,
163 Expansion_Factor => 2,
164 Compression_Threshold => 0.3,
165 Compression_Factor => 2,
167 Destroy_Value => Destroy,
170 -- The following map relates invocation signature records to invocation
173 Sig_To_Sig_Map : constant Sig_Map.Dynamic_Hash_Table :=
174 Sig_Map.Create (500);
176 -- The folowing table maps declaration placement kinds to character codes
177 -- for invocation construct encoding in ALI files.
179 Declaration_Placement_Codes :
180 constant array (Declaration_Placement_Kind) of Character :=
183 No_Declaration_Placement => 'Z');
185 Compile_Time_Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind :=
187 -- The invocation-graph encoding format as specified at compile time. Do
188 -- not manipulate this value directly.
190 -- The following table maps invocation kinds to character codes for
191 -- invocation relation encoding in ALI files.
194 constant array (Invocation_Kind) of Character :=
195 (Accept_Alternative => 'a',
198 Controlled_Adjustment => 'd',
199 Controlled_Finalization => 'e',
200 Controlled_Initialization => 'f',
201 Default_Initial_Condition_Verification => 'g',
202 Initial_Condition_Verification => 'h',
203 Instantiation => 'i',
204 Internal_Controlled_Adjustment => 'j',
205 Internal_Controlled_Finalization => 'k',
206 Internal_Controlled_Initialization => 'l',
207 Invariant_Verification => 'm',
208 Postcondition_Verification => 'n',
209 Protected_Entry_Call => 'o',
210 Protected_Subprogram_Call => 'p',
211 Task_Activation => 'q',
212 Task_Entry_Call => 'r',
213 Type_Initialization => 's',
214 No_Invocation => 'Z');
216 -- The following table maps invocation construct kinds to character codes
217 -- for invocation construct encoding in ALI files.
219 Invocation_Construct_Codes :
220 constant array (Invocation_Construct_Kind) of Character :=
221 (Elaborate_Body_Procedure => 'b',
222 Elaborate_Spec_Procedure => 's',
223 Regular_Construct => 'Z');
225 -- The following table maps invocation-graph encoding kinds to character
226 -- codes for invocation-graph encoding in ALI files.
228 Invocation_Graph_Encoding_Codes :
229 constant array (Invocation_Graph_Encoding_Kind) of Character :=
230 (Full_Path_Encoding => 'f',
231 Endpoints_Encoding => 'e',
234 -- The following table maps invocation-graph line kinds to character codes
235 -- used in ALI files.
237 Invocation_Graph_Line_Codes :
238 constant array (Invocation_Graph_Line_Kind) of Character :=
239 (Invocation_Construct_Line => 'c',
240 Invocation_Graph_Attributes_Line => 'a',
241 Invocation_Relation_Line => 'r');
243 -- The following variable records which characters currently are used as
244 -- line type markers in the ALI file. This is used in Scan_ALI to detect
245 -- (or skip) invalid lines. The following letters are still available:
249 Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean :=
250 ('A' => True, -- argument
251 'C' => True, -- SCO information
252 'D' => True, -- dependency
253 'E' => True, -- external
254 'G' => True, -- invocation graph
255 'I' => True, -- interrupt
256 'L' => True, -- linker option
257 'M' => True, -- main program
258 'N' => True, -- notes
259 'P' => True, -- program
260 'R' => True, -- restriction
261 'S' => True, -- specific dispatching
262 'T' => True, -- task stack information
264 'V' => True, -- version
267 'Y' => True, -- limited_with
268 'Z' => True, -- implicit with from instantiation
271 ------------------------------
272 -- Add_Invocation_Construct --
273 ------------------------------
275 procedure Add_Invocation_Construct
276 (Body_Placement : Declaration_Placement_Kind;
277 Kind : Invocation_Construct_Kind;
278 Signature : Invocation_Signature_Id;
279 Spec_Placement : Declaration_Placement_Kind;
280 Update_Units : Boolean := True)
283 pragma Assert (Present (Signature));
285 -- Create a invocation construct from the scanned attributes
287 Invocation_Constructs.Append
288 ((Body_Placement => Body_Placement,
290 Signature => Signature,
291 Spec_Placement => Spec_Placement));
293 -- Update the invocation construct counter of the current unit only when
294 -- requested by the caller.
298 Curr_Unit : Unit_Record renames Units.Table (Units.Last);
301 Curr_Unit.Last_Invocation_Construct := Invocation_Constructs.Last;
304 end Add_Invocation_Construct;
306 -----------------------------
307 -- Add_Invocation_Relation --
308 -----------------------------
310 procedure Add_Invocation_Relation
312 Invoker : Invocation_Signature_Id;
313 Kind : Invocation_Kind;
314 Target : Invocation_Signature_Id;
315 Update_Units : Boolean := True)
318 pragma Assert (Present (Invoker));
319 pragma Assert (Kind /= No_Invocation);
320 pragma Assert (Present (Target));
322 -- Create an invocation relation from the scanned attributes
324 Invocation_Relations.Append
330 -- Update the invocation relation counter of the current unit only when
331 -- requested by the caller.
335 Curr_Unit : Unit_Record renames Units.Table (Units.Last);
338 Curr_Unit.Last_Invocation_Relation := Invocation_Relations.Last;
341 end Add_Invocation_Relation;
347 function Body_Placement
348 (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
351 pragma Assert (Present (IC_Id));
352 return Invocation_Constructs.Table (IC_Id).Body_Placement;
355 ----------------------------------------
356 -- Code_To_Declaration_Placement_Kind --
357 ----------------------------------------
359 function Code_To_Declaration_Placement_Kind
360 (Code : Character) return Declaration_Placement_Kind
363 -- Determine which placement kind corresponds to the character code by
364 -- traversing the contents of the mapping table.
366 for Kind in Declaration_Placement_Kind loop
367 if Declaration_Placement_Codes (Kind) = Code then
373 end Code_To_Declaration_Placement_Kind;
375 ---------------------------------------
376 -- Code_To_Invocation_Construct_Kind --
377 ---------------------------------------
379 function Code_To_Invocation_Construct_Kind
380 (Code : Character) return Invocation_Construct_Kind
383 -- Determine which invocation construct kind matches the character code
384 -- by traversing the contents of the mapping table.
386 for Kind in Invocation_Construct_Kind loop
387 if Invocation_Construct_Codes (Kind) = Code then
393 end Code_To_Invocation_Construct_Kind;
395 --------------------------------------------
396 -- Code_To_Invocation_Graph_Encoding_Kind --
397 --------------------------------------------
399 function Code_To_Invocation_Graph_Encoding_Kind
400 (Code : Character) return Invocation_Graph_Encoding_Kind
403 -- Determine which invocation-graph encoding kind matches the character
404 -- code by traversing the contents of the mapping table.
406 for Kind in Invocation_Graph_Encoding_Kind loop
407 if Invocation_Graph_Encoding_Codes (Kind) = Code then
413 end Code_To_Invocation_Graph_Encoding_Kind;
415 -----------------------------
416 -- Code_To_Invocation_Kind --
417 -----------------------------
419 function Code_To_Invocation_Kind
420 (Code : Character) return Invocation_Kind
423 -- Determine which invocation kind corresponds to the character code by
424 -- traversing the contents of the mapping table.
426 for Kind in Invocation_Kind loop
427 if Invocation_Codes (Kind) = Code then
433 end Code_To_Invocation_Kind;
435 ----------------------------------------
436 -- Code_To_Invocation_Graph_Line_Kind --
437 ----------------------------------------
439 function Code_To_Invocation_Graph_Line_Kind
440 (Code : Character) return Invocation_Graph_Line_Kind
443 -- Determine which invocation-graph line kind matches the character
444 -- code by traversing the contents of the mapping table.
446 for Kind in Invocation_Graph_Line_Kind loop
447 if Invocation_Graph_Line_Codes (Kind) = Code then
453 end Code_To_Invocation_Graph_Line_Kind;
459 function Column (IS_Id : Invocation_Signature_Id) return Nat is
461 pragma Assert (Present (IS_Id));
462 return Invocation_Signatures.Table (IS_Id).Column;
465 ----------------------------------------
466 -- Declaration_Placement_Kind_To_Code --
467 ----------------------------------------
469 function Declaration_Placement_Kind_To_Code
470 (Kind : Declaration_Placement_Kind) return Character
473 return Declaration_Placement_Codes (Kind);
474 end Declaration_Placement_Kind_To_Code;
480 procedure Destroy (IS_Id : in out Invocation_Signature_Id) is
481 pragma Unreferenced (IS_Id);
490 function Extra (IR_Id : Invocation_Relation_Id) return Name_Id is
492 pragma Assert (Present (IR_Id));
493 return Invocation_Relations.Table (IR_Id).Extra;
496 -----------------------------------
497 -- For_Each_Invocation_Construct --
498 -----------------------------------
500 procedure For_Each_Invocation_Construct
501 (Processor : Invocation_Construct_Processor_Ptr)
504 pragma Assert (Processor /= null);
506 for IC_Id in Invocation_Constructs.First ..
507 Invocation_Constructs.Last
509 Processor.all (IC_Id);
511 end For_Each_Invocation_Construct;
513 -----------------------------------
514 -- For_Each_Invocation_Construct --
515 -----------------------------------
517 procedure For_Each_Invocation_Construct
519 Processor : Invocation_Construct_Processor_Ptr)
521 pragma Assert (Present (U_Id));
522 pragma Assert (Processor /= null);
524 U_Rec : Unit_Record renames Units.Table (U_Id);
527 for IC_Id in U_Rec.First_Invocation_Construct ..
528 U_Rec.Last_Invocation_Construct
530 Processor.all (IC_Id);
532 end For_Each_Invocation_Construct;
534 ----------------------------------
535 -- For_Each_Invocation_Relation --
536 ----------------------------------
538 procedure For_Each_Invocation_Relation
539 (Processor : Invocation_Relation_Processor_Ptr)
542 pragma Assert (Processor /= null);
544 for IR_Id in Invocation_Relations.First ..
545 Invocation_Relations.Last
547 Processor.all (IR_Id);
549 end For_Each_Invocation_Relation;
551 ----------------------------------
552 -- For_Each_Invocation_Relation --
553 ----------------------------------
555 procedure For_Each_Invocation_Relation
557 Processor : Invocation_Relation_Processor_Ptr)
559 pragma Assert (Present (U_Id));
560 pragma Assert (Processor /= null);
562 U_Rec : Unit_Record renames Units.Table (U_Id);
565 for IR_Id in U_Rec.First_Invocation_Relation ..
566 U_Rec.Last_Invocation_Relation
568 Processor.all (IR_Id);
570 end For_Each_Invocation_Relation;
577 (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type
579 Buffer : Bounded_String (2052);
583 -- The hash is obtained in the following manner:
585 -- * A String signature based on the scope, name, line number, column
586 -- number, and locations, in the following format:
588 -- scope__name__line_column__locations
590 -- * The String is converted into a Name_Id
591 -- * The Name_Id is used as the hash
593 Append (Buffer, IS_Rec.Scope);
594 Append (Buffer, "__");
595 Append (Buffer, IS_Rec.Name);
596 Append (Buffer, "__");
597 Append (Buffer, IS_Rec.Line);
598 Append (Buffer, '_');
599 Append (Buffer, IS_Rec.Column);
601 if IS_Rec.Locations /= No_Name then
602 Append (Buffer, "__");
603 Append (Buffer, IS_Rec.Locations);
606 IS_Nam := Name_Find (Buffer);
607 return Bucket_Range_Type (IS_Nam);
614 procedure Initialize_ALI is
616 -- When (re)initializing ALI data structures the ALI user expects to
617 -- get a fresh set of data structures. Thus we first need to erase the
618 -- marks put in the name table by the previous set of ALI routine calls.
619 -- These two loops are empty and harmless the first time in.
621 for J in ALIs.First .. ALIs.Last loop
622 Set_Name_Table_Int (ALIs.Table (J).Afile, 0);
625 for J in Units.First .. Units.Last loop
626 Set_Name_Table_Int (Units.Table (J).Uname, 0);
629 -- Free argument table strings
631 for J in Args.First .. Args.Last loop
632 Free (Args.Table (J));
635 -- Initialize all tables
638 Invocation_Constructs.Init;
639 Invocation_Relations.Init;
640 Invocation_Signatures.Init;
652 -- Add dummy zeroth item in Linker_Options and Notes for sort calls
654 Linker_Options.Increment_Last;
655 Notes.Increment_Last;
657 -- Initialize global variables recording cumulative options in all
658 -- ALI files that are read for a given processing run in gnatbind.
660 Dynamic_Elaboration_Checks_Specified := False;
661 Locking_Policy_Specified := ' ';
662 No_Normalize_Scalars_Specified := False;
663 No_Object_Specified := False;
664 No_Component_Reordering_Specified := False;
665 GNATprove_Mode_Specified := False;
666 Normalize_Scalars_Specified := False;
667 Partition_Elaboration_Policy_Specified := ' ';
668 Queuing_Policy_Specified := ' ';
669 SSO_Default_Specified := False;
670 Task_Dispatching_Policy_Specified := ' ';
671 Unreserve_All_Interrupts_Specified := False;
672 Frontend_Exceptions_Specified := False;
673 Zero_Cost_Exceptions_Specified := False;
676 ---------------------------------------
677 -- Invocation_Construct_Kind_To_Code --
678 ---------------------------------------
680 function Invocation_Construct_Kind_To_Code
681 (Kind : Invocation_Construct_Kind) return Character
684 return Invocation_Construct_Codes (Kind);
685 end Invocation_Construct_Kind_To_Code;
687 -------------------------------
688 -- Invocation_Graph_Encoding --
689 -------------------------------
691 function Invocation_Graph_Encoding return Invocation_Graph_Encoding_Kind is
693 return Compile_Time_Invocation_Graph_Encoding;
694 end Invocation_Graph_Encoding;
696 --------------------------------------------
697 -- Invocation_Graph_Encoding_Kind_To_Code --
698 --------------------------------------------
700 function Invocation_Graph_Encoding_Kind_To_Code
701 (Kind : Invocation_Graph_Encoding_Kind) return Character
704 return Invocation_Graph_Encoding_Codes (Kind);
705 end Invocation_Graph_Encoding_Kind_To_Code;
707 ----------------------------------------
708 -- Invocation_Graph_Line_Kind_To_Code --
709 ----------------------------------------
711 function Invocation_Graph_Line_Kind_To_Code
712 (Kind : Invocation_Graph_Line_Kind) return Character
715 return Invocation_Graph_Line_Codes (Kind);
716 end Invocation_Graph_Line_Kind_To_Code;
718 -----------------------------
719 -- Invocation_Kind_To_Code --
720 -----------------------------
722 function Invocation_Kind_To_Code
723 (Kind : Invocation_Kind) return Character
726 return Invocation_Codes (Kind);
727 end Invocation_Kind_To_Code;
729 -----------------------------
730 -- Invocation_Signature_Of --
731 -----------------------------
733 function Invocation_Signature_Of
738 Scope : Name_Id) return Invocation_Signature_Id
740 IS_Rec : constant Invocation_Signature_Record :=
743 Locations => Locations,
746 IS_Id : Invocation_Signature_Id;
749 IS_Id := Sig_Map.Get (Sig_To_Sig_Map, IS_Rec);
751 -- The invocation signature lacks an id. This indicates that it
752 -- is encountered for the first time during the construction of
755 if not Present (IS_Id) then
756 Invocation_Signatures.Append (IS_Rec);
757 IS_Id := Invocation_Signatures.Last;
759 -- Map the invocation signature record to its corresponding id
761 Sig_Map.Put (Sig_To_Sig_Map, IS_Rec, IS_Id);
765 end Invocation_Signature_Of;
772 (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
775 pragma Assert (Present (IR_Id));
776 return Invocation_Relations.Table (IR_Id).Invoker;
784 (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind
787 pragma Assert (Present (IC_Id));
788 return Invocation_Constructs.Table (IC_Id).Kind;
795 function Kind (IR_Id : Invocation_Relation_Id) return Invocation_Kind is
797 pragma Assert (Present (IR_Id));
798 return Invocation_Relations.Table (IR_Id).Kind;
805 function Line (IS_Id : Invocation_Signature_Id) return Nat is
807 pragma Assert (Present (IS_Id));
808 return Invocation_Signatures.Table (IS_Id).Line;
815 function Locations (IS_Id : Invocation_Signature_Id) return Name_Id is
817 pragma Assert (Present (IS_Id));
818 return Invocation_Signatures.Table (IS_Id).Locations;
825 function Name (IS_Id : Invocation_Signature_Id) return Name_Id is
827 pragma Assert (Present (IS_Id));
828 return Invocation_Signatures.Table (IS_Id).Name;
835 function Present (IC_Id : Invocation_Construct_Id) return Boolean is
837 return IC_Id /= No_Invocation_Construct;
844 function Present (IR_Id : Invocation_Relation_Id) return Boolean is
846 return IR_Id /= No_Invocation_Relation;
853 function Present (IS_Id : Invocation_Signature_Id) return Boolean is
855 return IS_Id /= No_Invocation_Signature;
862 function Present (Dep : Sdep_Id) return Boolean is
864 return Dep /= No_Sdep_Id;
871 function Present (U_Id : Unit_Id) return Boolean is
873 return U_Id /= No_Unit_Id;
880 function Present (W_Id : With_Id) return Boolean is
882 return W_Id /= No_With_Id;
894 Read_Xref : Boolean := False;
895 Read_Lines : String := "";
896 Ignore_Lines : String := "X";
897 Ignore_Errors : Boolean := False;
898 Directly_Scanned : Boolean := False) return ALI_Id
900 P : Text_Ptr := T'First;
901 Line : Logical_Line_Number := 1;
907 Ignore : array (Character range 'A' .. 'Z') of Boolean;
908 -- Ignore (X) is set to True if lines starting with X are to
909 -- be ignored by Scan_ALI and skipped, and False if the lines
910 -- are to be read and processed.
912 Bad_ALI_Format : exception;
913 -- Exception raised by Fatal_Error if Err is True
915 function At_Eol return Boolean;
916 -- Test if at end of line
918 function At_End_Of_Field return Boolean;
919 -- Test if at end of line, or if at blank or horizontal tab
921 procedure Check_At_End_Of_Field;
922 -- Check if we are at end of field, fatal error if not
924 procedure Checkc (C : Character);
925 -- Check next character is C. If so bump past it, if not fatal error
927 procedure Check_Unknown_Line;
928 -- If Ignore_Errors mode, then checks C to make sure that it is not
929 -- an unknown ALI line type characters, and if so, skips lines
930 -- until the first character of the line is one of these characters,
931 -- at which point it does a Getc to put that character in C. The
932 -- call has no effect if C is already an appropriate character.
933 -- If not in Ignore_Errors mode, a fatal error is signalled if the
934 -- line is unknown. Note that if C is an EOL on entry, the line is
935 -- skipped (it is assumed that blank lines are never significant).
936 -- If C is EOF on entry, the call has no effect (it is assumed that
937 -- the caller will properly handle this case).
939 procedure Fatal_Error;
940 -- Generate fatal error message for badly formatted ALI file if
941 -- Err is false, or raise Bad_ALI_Format if Err is True.
943 procedure Fatal_Error_Ignore;
944 pragma Inline (Fatal_Error_Ignore);
945 -- In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
947 function Getc return Character;
948 -- Get next character, bumping P past the character obtained
950 function Get_File_Name
951 (Lower : Boolean := False;
952 May_Be_Quoted : Boolean := False) return File_Name_Type;
953 -- Skip blanks, then scan out a file name (name is left in Name_Buffer
954 -- with length in Name_Len, as well as returning a File_Name_Type value.
955 -- If May_Be_Quoted is True and the first non blank character is '"',
956 -- then remove starting and ending quotes and undoubled internal quotes.
957 -- If lower is false, the case is unchanged, if Lower is True then the
958 -- result is forced to all lower case for systems where file names are
959 -- not case sensitive. This ensures that gnatbind works correctly
960 -- regardless of the case of the file name on all systems. The scan
961 -- is terminated by a end of line, space or horizontal tab. Any other
962 -- special characters are included in the returned name.
965 (Ignore_Spaces : Boolean := False;
966 Ignore_Special : Boolean := False;
967 May_Be_Quoted : Boolean := False) return Name_Id;
968 -- Skip blanks, then scan out a name (name is left in Name_Buffer with
969 -- length in Name_Len, as well as being returned in Name_Id form).
970 -- If Lower is set to True then the Name_Buffer will be converted to
971 -- all lower case, for systems where file names are not case sensitive.
972 -- This ensures that gnatbind works correctly regardless of the case
973 -- of the file name on all systems. The termination condition depends
974 -- on the settings of Ignore_Spaces and Ignore_Special:
976 -- If Ignore_Spaces is False (normal case), then scan is terminated
977 -- by the normal end of field condition (EOL, space, horizontal tab)
979 -- If Ignore_Special is False (normal case), the scan is terminated by
980 -- a typeref bracket or an equal sign except for the special case of
981 -- an operator name starting with a double quote that is terminated
982 -- by another double quote.
984 -- If May_Be_Quoted is True and the first non blank character is '"'
985 -- the name is 'unquoted'. In this case Ignore_Special is ignored and
986 -- assumed to be True.
988 -- It is an error to set both Ignore_Spaces and Ignore_Special to True.
989 -- This function handles wide characters properly.
991 function Get_Nat return Nat;
992 -- Skip blanks, then scan out an unsigned integer value in Nat range
993 -- raises ALI_Reading_Error if the encoutered type is not natural.
995 function Get_Stamp return Time_Stamp_Type;
996 -- Skip blanks, then scan out a time stamp
998 function Get_Unit_Name return Unit_Name_Type;
999 -- Skip blanks, then scan out a file name (name is left in Name_Buffer
1000 -- with length in Name_Len, as well as returning a Unit_Name_Type value.
1001 -- The case is unchanged and terminated by a normal end of field.
1003 function Nextc return Character;
1004 -- Return current character without modifying pointer P
1006 procedure Get_Typeref
1007 (Current_File_Num : Sdep_Id;
1008 Ref : out Tref_Kind;
1009 File_Num : out Sdep_Id;
1011 Ref_Type : out Character;
1013 Standard_Entity : out Name_Id);
1014 -- Parse the definition of a typeref (<...>, {...} or (...))
1016 procedure Scan_Invocation_Graph_Line;
1017 -- Parse a single line that encodes a piece of the invocation graph
1020 -- Skip past spaces, then skip past end of line (fatal error if not
1021 -- at end of line). Also skips past any following blank lines.
1023 procedure Skip_Line;
1024 -- Skip rest of current line and any following blank lines
1026 procedure Skip_Space;
1027 -- Skip past white space (blanks or horizontal tab)
1030 -- Skip past next character, does not affect value in C. This call
1031 -- is like calling Getc and ignoring the returned result.
1033 ---------------------
1034 -- At_End_Of_Field --
1035 ---------------------
1037 function At_End_Of_Field return Boolean is
1039 return Nextc <= ' ';
1040 end At_End_Of_Field;
1046 function At_Eol return Boolean is
1048 return Nextc = EOF or else Nextc = CR or else Nextc = LF;
1051 ---------------------------
1052 -- Check_At_End_Of_Field --
1053 ---------------------------
1055 procedure Check_At_End_Of_Field is
1057 if not At_End_Of_Field then
1058 if Ignore_Errors then
1059 while Nextc > ' ' loop
1066 end Check_At_End_Of_Field;
1068 ------------------------
1069 -- Check_Unknown_Line --
1070 ------------------------
1072 procedure Check_Unknown_Line is
1074 while C not in 'A' .. 'Z'
1075 or else not Known_ALI_Lines (C)
1077 if C = CR or else C = LF then
1084 elsif Ignore_Errors then
1092 end Check_Unknown_Line;
1098 procedure Checkc (C : Character) is
1102 elsif Ignore_Errors then
1113 procedure Fatal_Error is
1118 procedure Wchar (C : Character);
1119 -- Write a single character, replacing horizontal tab by spaces
1121 procedure Wchar (C : Character) is
1126 exit when Col mod 8 = 0;
1135 -- Start of processing for Fatal_Error
1139 raise Bad_ALI_Format;
1143 Write_Str ("fatal error: file ");
1145 Write_Str (" is incorrectly formatted");
1148 Write_Str ("make sure you are using consistent versions " &
1150 -- Split the following line so that it can easily be transformed for
1151 -- other back-ends where the compiler might have a different name.
1157 -- Find start of line
1160 while Ptr1 > T'First
1161 and then T (Ptr1 - 1) /= CR
1162 and then T (Ptr1 - 1) /= LF
1167 Write_Int (Int (Line));
1182 and then T (Ptr2) /= CR
1183 and then T (Ptr2) /= LF
1195 if T (Ptr1) = HT then
1207 Exit_Program (E_Fatal);
1210 ------------------------
1211 -- Fatal_Error_Ignore --
1212 ------------------------
1214 procedure Fatal_Error_Ignore is
1216 if not Ignore_Errors then
1219 end Fatal_Error_Ignore;
1225 function Get_File_Name
1226 (Lower : Boolean := False;
1227 May_Be_Quoted : Boolean := False) return File_Name_Type
1232 F := Get_Name (Ignore_Special => True,
1233 May_Be_Quoted => May_Be_Quoted);
1235 -- Convert file name to all lower case if file names are not case
1236 -- sensitive. This ensures that we handle names in the canonical
1237 -- lower case format, regardless of the actual case.
1239 if Lower and not File_Names_Case_Sensitive then
1240 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1243 return File_Name_Type (F);
1252 (Ignore_Spaces : Boolean := False;
1253 Ignore_Special : Boolean := False;
1254 May_Be_Quoted : Boolean := False) return Name_Id
1263 if Ignore_Errors then
1272 -- Deal with quoted characters
1274 if May_Be_Quoted and then Char = '"' then
1277 if Ignore_Errors then
1300 Add_Char_To_Name_Buffer (Char);
1303 -- Other than case of quoted character
1308 Add_Char_To_Name_Buffer (Getc);
1310 exit when At_End_Of_Field and then not Ignore_Spaces;
1312 if not Ignore_Special then
1313 if Name_Buffer (1) = '"' then
1314 exit when Name_Len > 1
1315 and then Name_Buffer (Name_Len) = '"';
1318 -- Terminate on parens or angle brackets or equal sign
1320 exit when Nextc = '(' or else Nextc = ')'
1321 or else Nextc = '{' or else Nextc = '}'
1322 or else Nextc = '<' or else Nextc = '>'
1323 or else Nextc = '=';
1325 -- Terminate on comma
1327 exit when Nextc = ',';
1329 -- Terminate if left bracket not part of wide char
1330 -- sequence Note that we only recognize brackets
1331 -- notation so far ???
1333 exit when Nextc = '[' and then T (P + 1) /= '"';
1335 -- Terminate if right bracket not part of wide char
1338 exit when Nextc = ']' and then T (P - 1) /= '"';
1351 function Get_Unit_Name return Unit_Name_Type is
1353 return Unit_Name_Type (Get_Name);
1360 function Get_Nat return Nat is
1366 -- Check if we are on a number. In the case of bad ALI files, this
1369 if not (Nextc in '0' .. '9') then
1375 V := V * 10 + (Character'Pos (Getc) - Character'Pos ('0'));
1377 exit when At_End_Of_Field;
1378 exit when Nextc < '0' or else Nextc > '9';
1388 function Get_Stamp return Time_Stamp_Type is
1389 T : Time_Stamp_Type;
1396 if Ignore_Errors then
1397 return Dummy_Time_Stamp;
1403 -- Following reads old style time stamp missing first two digits
1405 if Nextc in '7' .. '9' then
1410 -- Normal case of full year in time stamp
1416 for J in Start .. T'Last loop
1427 procedure Get_Typeref
1428 (Current_File_Num : Sdep_Id;
1429 Ref : out Tref_Kind;
1430 File_Num : out Sdep_Id;
1432 Ref_Type : out Character;
1434 Standard_Entity : out Name_Id)
1439 when '<' => Ref := Tref_Derived;
1440 when '(' => Ref := Tref_Access;
1441 when '{' => Ref := Tref_Type;
1442 when others => Ref := Tref_None;
1445 -- Case of typeref field present
1447 if Ref /= Tref_None then
1448 P := P + 1; -- skip opening bracket
1450 if Nextc in 'a' .. 'z' then
1451 File_Num := No_Sdep_Id;
1455 Standard_Entity := Get_Name (Ignore_Spaces => True);
1460 File_Num := Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1464 File_Num := Current_File_Num;
1470 Standard_Entity := No_Name;
1473 -- ??? Temporary workaround for nested generics case:
1474 -- 4i4 Directories{1|4I9[4|6[3|3]]}
1478 Nested_Brackets : Natural := 0;
1484 Nested_Brackets := Nested_Brackets + 1;
1486 Nested_Brackets := Nested_Brackets - 1;
1488 if Nested_Brackets = 0 then
1497 P := P + 1; -- skip closing bracket
1500 -- No typeref entry present
1503 File_Num := No_Sdep_Id;
1507 Standard_Entity := No_Name;
1515 function Getc return Character is
1529 function Nextc return Character is
1534 --------------------------------
1535 -- Scan_Invocation_Graph_Line --
1536 --------------------------------
1538 procedure Scan_Invocation_Graph_Line is
1539 procedure Scan_Invocation_Construct_Line;
1540 pragma Inline (Scan_Invocation_Construct_Line);
1541 -- Parse an invocation construct line and construct the corresponding
1542 -- construct. The following data structures are updated:
1544 -- * Invocation_Constructs
1547 procedure Scan_Invocation_Graph_Attributes_Line;
1548 pragma Inline (Scan_Invocation_Graph_Attributes_Line);
1549 -- Parse an invocation-graph attributes line. The following data
1550 -- structures are updated:
1554 procedure Scan_Invocation_Relation_Line;
1555 pragma Inline (Scan_Invocation_Relation_Line);
1556 -- Parse an invocation relation line and construct the corresponding
1557 -- relation. The following data structures are updated:
1559 -- * Invocation_Relations
1562 function Scan_Invocation_Signature return Invocation_Signature_Id;
1563 pragma Inline (Scan_Invocation_Signature);
1564 -- Parse a single invocation signature while populating the following
1567 -- * Invocation_Signatures
1570 ------------------------------------
1571 -- Scan_Invocation_Construct_Line --
1572 ------------------------------------
1574 procedure Scan_Invocation_Construct_Line is
1575 Body_Placement : Declaration_Placement_Kind;
1576 Kind : Invocation_Construct_Kind;
1577 Signature : Invocation_Signature_Id;
1578 Spec_Placement : Declaration_Placement_Kind;
1583 Kind := Code_To_Invocation_Construct_Kind (Getc);
1587 -- construct-spec-placement
1589 Spec_Placement := Code_To_Declaration_Placement_Kind (Getc);
1593 -- construct-body-placement
1595 Body_Placement := Code_To_Declaration_Placement_Kind (Getc);
1599 -- construct-signature
1601 Signature := Scan_Invocation_Signature;
1604 Add_Invocation_Construct
1605 (Body_Placement => Body_Placement,
1607 Signature => Signature,
1608 Spec_Placement => Spec_Placement);
1609 end Scan_Invocation_Construct_Line;
1611 -------------------------------------------
1612 -- Scan_Invocation_Graph_Attributes_Line --
1613 -------------------------------------------
1615 procedure Scan_Invocation_Graph_Attributes_Line is
1619 Set_Invocation_Graph_Encoding
1620 (Code_To_Invocation_Graph_Encoding_Kind (Getc));
1622 end Scan_Invocation_Graph_Attributes_Line;
1624 -----------------------------------
1625 -- Scan_Invocation_Relation_Line --
1626 -----------------------------------
1628 procedure Scan_Invocation_Relation_Line is
1630 Invoker : Invocation_Signature_Id;
1631 Kind : Invocation_Kind;
1632 Target : Invocation_Signature_Id;
1637 Kind := Code_To_Invocation_Kind (Getc);
1641 -- (extra-name | "none")
1645 if Extra = Name_None then
1652 -- invoker-signature
1654 Invoker := Scan_Invocation_Signature;
1660 Target := Scan_Invocation_Signature;
1663 Add_Invocation_Relation
1668 end Scan_Invocation_Relation_Line;
1670 -------------------------------
1671 -- Scan_Invocation_Signature --
1672 -------------------------------
1674 function Scan_Invocation_Signature return Invocation_Signature_Id is
1677 Locations : Name_Id;
1710 -- (locations | "none")
1712 Locations := Get_Name;
1714 if Locations = Name_None then
1715 Locations := No_Name;
1722 -- Create an invocation signature from the scanned attributes
1725 Invocation_Signature_Of
1728 Locations => Locations,
1731 end Scan_Invocation_Signature;
1735 Line : Invocation_Graph_Line_Kind;
1737 -- Start of processing for Scan_Invocation_Graph_Line
1740 if Ignore ('G') then
1749 Line := Code_To_Invocation_Graph_Line_Kind (Getc);
1756 when Invocation_Construct_Line =>
1757 Scan_Invocation_Construct_Line;
1759 when Invocation_Graph_Attributes_Line =>
1760 Scan_Invocation_Graph_Attributes_Line;
1762 when Invocation_Relation_Line =>
1763 Scan_Invocation_Relation_Line;
1765 end Scan_Invocation_Graph_Line;
1771 procedure Skip_Eol is
1776 if Ignore_Errors then
1777 while not At_Eol loop
1785 -- Loop to skip past blank lines (first time through skips this EOL)
1787 while Nextc < ' ' and then Nextc /= EOF loop
1800 procedure Skip_Line is
1802 while not At_Eol loop
1813 procedure Skip_Space is
1815 while Nextc = ' ' or else Nextc = HT loop
1831 -- Start of processing for Scan_ALI
1834 First_Sdep_Entry := Sdep.Last + 1;
1836 -- Acquire lines to be ignored
1840 ('T' | 'U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
1842 -- Read_Lines parameter given
1844 elsif Read_Lines /= "" then
1845 Ignore := ('U' => False, others => True);
1847 for J in Read_Lines'Range loop
1848 Ignore (Read_Lines (J)) := False;
1851 -- Process Ignore_Lines parameter
1854 Ignore := (others => False);
1856 for J in Ignore_Lines'Range loop
1857 pragma Assert (Ignore_Lines (J) /= 'U');
1858 Ignore (Ignore_Lines (J)) := True;
1862 -- Setup ALI Table entry with appropriate defaults
1864 ALIs.Increment_Last;
1866 Set_Name_Table_Int (F, Int (Id));
1868 ALIs.Table (Id) := (
1870 Compile_Errors => False,
1871 First_Interrupt_State => Interrupt_States.Last + 1,
1872 First_Sdep => No_Sdep_Id,
1873 First_Specific_Dispatching => Specific_Dispatching.Last + 1,
1874 First_Unit => No_Unit_Id,
1875 GNATprove_Mode => False,
1876 Invocation_Graph_Encoding => No_Encoding,
1877 Last_Interrupt_State => Interrupt_States.Last,
1878 Last_Sdep => No_Sdep_Id,
1879 Last_Specific_Dispatching => Specific_Dispatching.Last,
1880 Last_Unit => No_Unit_Id,
1881 Locking_Policy => ' ',
1882 Main_Priority => -1,
1884 Main_Program => None,
1885 No_Component_Reordering => False,
1887 Normalize_Scalars => False,
1888 Ofile_Full_Name => Full_Object_File_Name,
1889 Partition_Elaboration_Policy => ' ',
1890 Queuing_Policy => ' ',
1891 Restrictions => No_Restrictions,
1892 SAL_Interface => False,
1895 Task_Dispatching_Policy => ' ',
1896 Time_Slice_Value => -1,
1898 Unit_Exception_Table => False,
1899 Ver => (others => ' '),
1901 Frontend_Exceptions => False,
1902 Zero_Cost_Exceptions => False);
1904 -- Now we acquire the input lines from the ALI file. Note that the
1905 -- convention in the following code is that as we enter each section,
1906 -- C is set to contain the first character of the following line.
1911 -- Acquire library version
1915 -- The V line missing really indicates trouble, most likely it
1916 -- means we don't have an ALI file at all, so here we give a
1917 -- fatal error even if we are in Ignore_Errors mode.
1921 elsif Ignore ('V') then
1929 for J in 1 .. Ver_Len_Max loop
1932 ALIs.Table (Id).Ver (J) := C;
1933 ALIs.Table (Id).Ver_Len := J;
1942 -- Acquire main program line if present
1945 if Ignore ('M') then
1955 ALIs.Table (Id).Main_Program := Func;
1957 ALIs.Table (Id).Main_Program := Proc;
1967 ALIs.Table (Id).Main_Priority := Get_Nat;
1975 ALIs.Table (Id).Time_Slice_Value := Get_Nat;
1983 ALIs.Table (Id).Main_CPU := Get_Nat;
1990 ALIs.Table (Id).WC_Encoding := Getc;
1999 -- Acquire argument lines
2001 First_Arg := Args.Last + 1;
2005 exit A_Loop when C /= 'A';
2007 if Ignore ('A') then
2013 -- Scan out argument
2016 while not At_Eol loop
2017 Add_Char_To_Name_Buffer (Getc);
2020 -- If -fstack-check, record that it occurred. Note that an
2021 -- additional string parameter can be specified, in the form of
2022 -- -fstack-check={no|generic|specific}. "no" means no checking,
2023 -- "generic" means force the use of old-style checking, and
2024 -- "specific" means use the best checking method.
2027 and then Name_Buffer (1 .. 13) = "-fstack-check"
2028 and then Name_Buffer (1 .. Name_Len) /= "-fstack-check=no"
2030 Stack_Check_Switch_Set := True;
2033 -- Store the argument
2035 Args.Increment_Last;
2036 Args.Table (Args.Last) := new String'(Name_Buffer (1 .. Name_Len));
2049 if Ignore_Errors then
2061 if Ignore ('P') then
2069 while not At_Eol loop
2074 -- Processing for CE
2078 ALIs.Table (Id).Compile_Errors := True;
2080 -- Processing for DB
2084 Detect_Blocking := True;
2086 -- Processing for Ex
2089 Partition_Elaboration_Policy_Specified := Getc;
2090 ALIs.Table (Id).Partition_Elaboration_Policy :=
2091 Partition_Elaboration_Policy_Specified;
2093 -- Processing for FX
2099 ALIs.Table (Id).Frontend_Exceptions := True;
2100 Frontend_Exceptions_Specified := True;
2105 -- Processing for GP
2109 GNATprove_Mode_Specified := True;
2110 ALIs.Table (Id).GNATprove_Mode := True;
2112 -- Processing for Lx
2115 Locking_Policy_Specified := Getc;
2116 ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
2118 -- Processing for flags starting with N
2123 -- Processing for NC
2126 ALIs.Table (Id).No_Component_Reordering := True;
2127 No_Component_Reordering_Specified := True;
2129 -- Processing for NO
2132 ALIs.Table (Id).No_Object := True;
2133 No_Object_Specified := True;
2135 -- Processing for NR
2138 No_Run_Time_Mode := True;
2139 Configurable_Run_Time_Mode := True;
2141 -- Processing for NS
2144 ALIs.Table (Id).Normalize_Scalars := True;
2145 Normalize_Scalars_Specified := True;
2148 -- Invalid switch starting with N
2154 -- Processing for OH/OL
2159 if C = 'L' or else C = 'H' then
2160 ALIs.Table (Id).SSO_Default := C;
2161 SSO_Default_Specified := True;
2167 -- Processing for Qx
2170 Queuing_Policy_Specified := Getc;
2171 ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
2173 -- Processing for flags starting with S
2178 -- Processing for SL
2181 ALIs.Table (Id).SAL_Interface := True;
2183 -- Processing for SS
2186 Opt.Sec_Stack_Used := True;
2188 -- Invalid switch starting with S
2194 -- Processing for Tx
2197 Task_Dispatching_Policy_Specified := Getc;
2198 ALIs.Table (Id).Task_Dispatching_Policy :=
2199 Task_Dispatching_Policy_Specified;
2201 -- Processing for switch starting with U
2206 -- Processing for UA
2209 Unreserve_All_Interrupts_Specified := True;
2211 -- Processing for UX
2214 ALIs.Table (Id).Unit_Exception_Table := True;
2216 -- Invalid switches starting with U
2222 -- Processing for ZX
2228 ALIs.Table (Id).Zero_Cost_Exceptions := True;
2229 Zero_Cost_Exceptions_Specified := True;
2234 -- Invalid parameter
2242 if not NS_Found then
2243 No_Normalize_Scalars_Specified := True;
2252 -- Loop to skip to first restrictions line
2255 if Ignore_Errors then
2267 -- Ignore all 'R' lines if that is required
2269 if Ignore ('R') then
2275 -- Here we process the restrictions lines (other than unit name cases)
2278 Scan_Restrictions : declare
2279 Save_R : constant Restrictions_Info := Cumulative_Restrictions;
2280 -- Save cumulative restrictions in case we have a fatal error
2282 Bad_R_Line : exception;
2283 -- Signal bad restrictions line (raised on unexpected character)
2290 -- Named restriction case
2296 -- Loop through RR and RV lines
2298 while C = 'R' and then Nextc /= ' ' loop
2302 -- Acquire restriction name
2305 while not At_Eol and then Nextc /= '=' loop
2306 Name_Len := Name_Len + 1;
2307 Name_Buffer (Name_Len) := Getc;
2310 -- Now search list of restrictions to find match
2313 RN : String renames Name_Buffer (1 .. Name_Len);
2316 R := Restriction_Id'First;
2317 while R /= Not_A_Restriction_Id loop
2318 if Restriction_Id'Image (R) = RN then
2322 R := Restriction_Id'Succ (R);
2325 -- We don't recognize the restriction. This might be
2326 -- thought of as an error, and it really is, but we
2327 -- want to allow building with inconsistent versions
2328 -- of the binder and ali files (see comments at the
2329 -- start of package System.Rident), so we just ignore
2332 goto Done_With_Restriction_Line;
2339 -- Boolean restriction case
2341 when All_Boolean_Restrictions =>
2344 ALIs.Table (Id).Restrictions.Violated (R) :=
2346 Cumulative_Restrictions.Violated (R) := True;
2349 ALIs.Table (Id).Restrictions.Set (R) := True;
2350 Cumulative_Restrictions.Set (R) := True;
2356 -- Parameter restriction case
2358 when All_Parameter_Restrictions =>
2359 if At_Eol or else Nextc /= '=' then
2365 N := Natural (Get_Nat);
2372 ALIs.Table (Id).Restrictions.Set (R) := True;
2373 ALIs.Table (Id).Restrictions.Value (R) := N;
2375 if Cumulative_Restrictions.Set (R) then
2376 Cumulative_Restrictions.Value (R) :=
2378 (Cumulative_Restrictions.Value (R), N);
2380 Cumulative_Restrictions.Set (R) := True;
2381 Cumulative_Restrictions.Value (R) := N;
2384 -- Restriction violated
2387 ALIs.Table (Id).Restrictions.Violated (R) :=
2389 Cumulative_Restrictions.Violated (R) := True;
2390 ALIs.Table (Id).Restrictions.Count (R) := N;
2392 -- Checked Max_Parameter case
2394 if R in Checked_Max_Parameter_Restrictions then
2395 Cumulative_Restrictions.Count (R) :=
2397 (Cumulative_Restrictions.Count (R), N);
2399 -- Other checked parameter cases
2403 pragma Unsuppress (Overflow_Check);
2406 Cumulative_Restrictions.Count (R) :=
2407 Cumulative_Restrictions.Count (R) + N;
2410 when Constraint_Error =>
2412 -- A constraint error comes from the
2413 -- addition. We reset to the maximum
2414 -- and indicate that the real value
2417 Cumulative_Restrictions.Value (R) :=
2419 Cumulative_Restrictions.Unknown (R) :=
2428 ALIs.Table (Id).Restrictions.Unknown (R) :=
2430 Cumulative_Restrictions.Unknown (R) := True;
2433 -- Other than 'R' or 'V'
2443 -- Bizarre error case NOT_A_RESTRICTION
2445 when Not_A_Restriction_Id =>
2453 <<Done_With_Restriction_Line>>
2458 -- Positional restriction case
2464 -- Acquire information for boolean restrictions
2466 for R in All_Boolean_Restrictions loop
2471 ALIs.Table (Id).Restrictions.Violated (R) := True;
2472 Cumulative_Restrictions.Violated (R) := True;
2475 ALIs.Table (Id).Restrictions.Set (R) := True;
2476 Cumulative_Restrictions.Set (R) := True;
2486 -- Acquire information for parameter restrictions
2488 for RP in All_Parameter_Restrictions loop
2494 ALIs.Table (Id).Restrictions.Set (RP) := True;
2497 N : constant Integer := Integer (Get_Nat);
2499 ALIs.Table (Id).Restrictions.Value (RP) := N;
2501 if Cumulative_Restrictions.Set (RP) then
2502 Cumulative_Restrictions.Value (RP) :=
2504 (Cumulative_Restrictions.Value (RP), N);
2506 Cumulative_Restrictions.Set (RP) := True;
2507 Cumulative_Restrictions.Value (RP) := N;
2515 -- Acquire restrictions violations information
2523 ALIs.Table (Id).Restrictions.Violated (RP) := True;
2524 Cumulative_Restrictions.Violated (RP) := True;
2527 N : constant Integer := Integer (Get_Nat);
2530 ALIs.Table (Id).Restrictions.Count (RP) := N;
2532 if RP in Checked_Max_Parameter_Restrictions then
2533 Cumulative_Restrictions.Count (RP) :=
2535 (Cumulative_Restrictions.Count (RP), N);
2539 pragma Unsuppress (Overflow_Check);
2542 Cumulative_Restrictions.Count (RP) :=
2543 Cumulative_Restrictions.Count (RP) + N;
2546 when Constraint_Error =>
2548 -- A constraint error comes from the add. We
2549 -- reset to the maximum and indicate that the
2550 -- real value is now unknown.
2552 Cumulative_Restrictions.Value (RP) :=
2554 Cumulative_Restrictions.Unknown (RP) := True;
2560 ALIs.Table (Id).Restrictions.Unknown (RP) := True;
2561 Cumulative_Restrictions.Unknown (RP) := True;
2578 -- Here if error during scanning of restrictions line
2583 -- In Ignore_Errors mode, undo any changes to restrictions
2584 -- from this unit, and continue on, skipping remaining R
2585 -- lines for this unit.
2587 if Ignore_Errors then
2588 Cumulative_Restrictions := Save_R;
2589 ALIs.Table (Id).Restrictions := No_Restrictions;
2597 -- In normal mode, this is a fatal error
2602 end Scan_Restrictions;
2605 -- Acquire additional restrictions (No_Dependence) lines if present
2608 if Ignore ('R') then
2612 No_Deps.Append ((Id, Get_Name));
2619 -- Acquire 'I' lines if present
2624 if Ignore ('I') then
2630 I_State : Character;
2639 Interrupt_States.Append (
2640 (Interrupt_Id => Int_Num,
2641 Interrupt_State => I_State,
2642 IS_Pragma_Line => Line_No));
2644 ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
2652 -- Acquire 'S' lines if present
2657 if Ignore ('S') then
2673 First_Prio := Get_Nat;
2674 Last_Prio := Get_Nat;
2677 Specific_Dispatching.Append (
2678 (Dispatching_Policy => Policy,
2679 First_Priority => First_Prio,
2680 Last_Priority => Last_Prio,
2681 PSD_Pragma_Line => Line_No));
2683 ALIs.Table (Id).Last_Specific_Dispatching :=
2684 Specific_Dispatching.Last;
2693 -- Loop to acquire unit entries
2697 exit U_Loop when C /= 'U';
2699 -- Note: as per spec, we never ignore U lines
2703 Units.Increment_Last;
2705 if ALIs.Table (Id).First_Unit = No_Unit_Id then
2706 ALIs.Table (Id).First_Unit := Units.Last;
2710 UL : Unit_Record renames Units.Table (Units.Last);
2713 UL.Uname := Get_Unit_Name;
2714 UL.Predefined := Is_Predefined_Unit;
2715 UL.Internal := Is_Internal_Unit;
2717 UL.Sfile := Get_File_Name (Lower => True);
2719 UL.Preelab := False;
2720 UL.No_Elab := False;
2721 UL.Shared_Passive := False;
2723 UL.Remote_Types := False;
2724 UL.Serious_Errors := False;
2725 UL.Has_RACW := False;
2726 UL.Init_Scalars := False;
2727 UL.Is_Generic := False;
2728 UL.Icasing := Mixed_Case;
2729 UL.Kcasing := All_Lower_Case;
2730 UL.Dynamic_Elab := False;
2731 UL.Elaborate_Body := False;
2732 UL.Set_Elab_Entity := False;
2733 UL.Version := "00000000";
2734 UL.First_With := Withs.Last + 1;
2735 UL.First_Arg := First_Arg;
2736 UL.First_Invocation_Construct := Invocation_Constructs.Last + 1;
2737 UL.Last_Invocation_Construct := No_Invocation_Construct;
2738 UL.First_Invocation_Relation := Invocation_Relations.Last + 1;
2739 UL.Last_Invocation_Relation := No_Invocation_Relation;
2740 UL.Elab_Position := 0;
2741 UL.SAL_Interface := ALIs.Table (Id).SAL_Interface;
2742 UL.Directly_Scanned := Directly_Scanned;
2743 UL.Body_Needed_For_SAL := False;
2744 UL.Elaborate_Body_Desirable := False;
2745 UL.Optimize_Alignment := 'O';
2746 UL.Has_Finalizer := False;
2747 UL.Primary_Stack_Count := 0;
2748 UL.Sec_Stack_Count := 0;
2750 if Debug_Flag_U then
2751 Write_Str (" ----> reading unit ");
2752 Write_Int (Int (Units.Last));
2754 Write_Unit_Name (UL.Uname);
2755 Write_Str (" from file ");
2756 Write_Name (UL.Sfile);
2761 -- Check for duplicated unit in different files
2764 Info : constant Int := Get_Name_Table_Int
2765 (Units.Table (Units.Last).Uname);
2768 and then Units.Table (Units.Last).Sfile /=
2769 Units.Table (Unit_Id (Info)).Sfile
2771 -- If Err is set then ignore duplicate unit name. This is the
2772 -- case of a call from gnatmake, where the situation can arise
2773 -- from substitution of source files. In such situations, the
2774 -- processing in gnatmake will always result in any required
2775 -- recompilations in any case, and if we consider this to be
2776 -- an error we get strange cases (for example when a generic
2777 -- instantiation is replaced by a normal package) where we
2778 -- read the old ali file, decide to recompile, and then decide
2779 -- that the old and new ali files are incompatible.
2784 -- If Err is not set, then this is a fatal error. This is
2785 -- the case of being called from the binder, where we must
2786 -- definitely diagnose this as an error.
2790 Write_Str ("error: duplicate unit name: ");
2793 Write_Str ("error: unit """);
2794 Write_Unit_Name (Units.Table (Units.Last).Uname);
2795 Write_Str (""" found in file """);
2796 Write_Name_Decoded (Units.Table (Units.Last).Sfile);
2800 Write_Str ("error: unit """);
2801 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
2802 Write_Str (""" found in file """);
2803 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
2807 Exit_Program (E_Fatal);
2813 (Units.Table (Units.Last).Uname, Int (Units.Last));
2815 -- Scan out possible version and other parameters
2824 if C in '0' .. '9' or else C in 'a' .. 'f' then
2825 Units.Table (Units.Last).Version (1) := C;
2827 for J in 2 .. 8 loop
2829 Units.Table (Units.Last).Version (J) := C;
2838 Check_At_End_Of_Field;
2839 Units.Table (Units.Last).Elaborate_Body_Desirable := True;
2842 Check_At_End_Of_Field;
2843 Units.Table (Units.Last).Body_Needed_For_SAL := True;
2849 -- DE parameter (Dynamic elaboration checks)
2855 Check_At_End_Of_Field;
2856 Units.Table (Units.Last).Dynamic_Elab := True;
2857 Dynamic_Elaboration_Checks_Specified := True;
2868 Units.Table (Units.Last).Elaborate_Body := True;
2870 Units.Table (Units.Last).Set_Elab_Entity := True;
2875 Check_At_End_Of_Field;
2877 -- GE parameter (generic)
2883 Check_At_End_Of_Field;
2884 Units.Table (Units.Last).Is_Generic := True;
2889 -- IL/IS/IU parameters
2895 Units.Table (Units.Last).Icasing := All_Lower_Case;
2897 Units.Table (Units.Last).Init_Scalars := True;
2898 Initialize_Scalars_Used := True;
2900 Units.Table (Units.Last).Icasing := All_Upper_Case;
2905 Check_At_End_Of_Field;
2913 Units.Table (Units.Last).Kcasing := Mixed_Case;
2915 Units.Table (Units.Last).Kcasing := All_Upper_Case;
2920 Check_At_End_Of_Field;
2928 Units.Table (Units.Last).No_Elab := True;
2929 Check_At_End_Of_Field;
2934 -- PF/PR/PU/PK parameters
2940 Units.Table (Units.Last).Has_Finalizer := True;
2942 Units.Table (Units.Last).Preelab := True;
2944 Units.Table (Units.Last).Pure := True;
2946 Units.Table (Units.Last).Unit_Kind := 'p';
2951 Check_At_End_Of_Field;
2953 -- OL/OO/OS/OT parameters
2958 if C = 'L' or else C = 'O' or else C = 'S' or else C = 'T' then
2959 Units.Table (Units.Last).Optimize_Alignment := C;
2964 Check_At_End_Of_Field;
2972 Units.Table (Units.Last).RCI := True;
2974 Units.Table (Units.Last).Remote_Types := True;
2976 Units.Table (Units.Last).Has_RACW := True;
2981 Check_At_End_Of_Field;
2983 -- SE/SP/SU parameters
2989 Units.Table (Units.Last).Serious_Errors := True;
2991 Units.Table (Units.Last).Shared_Passive := True;
2993 Units.Table (Units.Last).Unit_Kind := 's';
2998 Check_At_End_Of_Field;
3010 -- Scan out With lines for this unit
3014 exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z';
3016 if Ignore ('W') then
3022 Withs.Increment_Last;
3023 Withs.Table (Withs.Last).Uname := Get_Unit_Name;
3024 Withs.Table (Withs.Last).Elaborate := False;
3025 Withs.Table (Withs.Last).Elaborate_All := False;
3026 Withs.Table (Withs.Last).Elab_Desirable := False;
3027 Withs.Table (Withs.Last).Elab_All_Desirable := False;
3028 Withs.Table (Withs.Last).SAL_Interface := False;
3029 Withs.Table (Withs.Last).Limited_With := (C = 'Y');
3030 Withs.Table (Withs.Last).Implicit_With := (C = 'Z');
3032 -- Generic case with no object file available
3035 Withs.Table (Withs.Last).Sfile := No_File;
3036 Withs.Table (Withs.Last).Afile := No_File;
3041 Withs.Table (Withs.Last).Sfile := Get_File_Name
3043 Withs.Table (Withs.Last).Afile := Get_File_Name
3046 -- Scan out possible E, EA, ED, and AD parameters
3048 while not At_Eol loop
3054 Check_At_End_Of_Field;
3056 -- Store AD indication unless ignore required
3058 if not Ignore_ED then
3059 Withs.Table (Withs.Last).Elab_All_Desirable := True;
3062 elsif Nextc = 'E' then
3065 if At_End_Of_Field then
3066 Withs.Table (Withs.Last).Elaborate := True;
3068 elsif Nextc = 'A' then
3070 Check_At_End_Of_Field;
3071 Withs.Table (Withs.Last).Elaborate_All := True;
3075 Check_At_End_Of_Field;
3077 -- Store ED indication unless ignore required
3079 if not Ignore_ED then
3080 Withs.Table (Withs.Last).Elab_Desirable :=
3097 Units.Table (Units.Last).Last_With := Withs.Last;
3098 Units.Table (Units.Last).Last_Arg := Args.Last;
3100 -- Scan out task stack information for the unit if present
3105 if Ignore ('T') then
3112 Units.Table (Units.Last).Primary_Stack_Count := Get_Nat;
3114 Units.Table (Units.Last).Sec_Stack_Count := Get_Nat;
3122 -- If there are linker options lines present, scan them
3126 Linker_Options_Loop : loop
3128 exit Linker_Options_Loop when C /= 'L';
3130 if Ignore ('L') then
3141 if C < Character'Val (16#20#)
3142 or else C > Character'Val (16#7E#)
3147 C := Character'Val (0);
3154 for J in 1 .. 2 loop
3157 if C in '0' .. '9' then
3160 Character'Pos ('0');
3162 elsif C in 'A' .. 'F' then
3165 Character'Pos ('A') +
3174 Add_Char_To_Name_Buffer (Character'Val (V));
3179 exit when Nextc /= '"';
3183 Add_Char_To_Name_Buffer (C);
3187 Add_Char_To_Name_Buffer (NUL);
3192 end loop Linker_Options_Loop;
3194 -- Store the linker options entry if one was found
3196 if Name_Len /= 0 then
3197 Linker_Options.Increment_Last;
3199 Linker_Options.Table (Linker_Options.Last).Name :=
3202 Linker_Options.Table (Linker_Options.Last).Unit :=
3205 Linker_Options.Table (Linker_Options.Last).Internal_File :=
3206 Is_Internal_File_Name (F);
3209 -- If there are notes present, scan them
3213 exit Notes_Loop when C /= 'N';
3215 if Ignore ('N') then
3221 Notes.Increment_Last;
3222 Notes.Table (Notes.Last).Pragma_Type := Getc;
3223 Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
3225 Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
3227 if not At_Eol and then Nextc = ':' then
3229 Notes.Table (Notes.Last).Pragma_Source_File :=
3230 Get_File_Name (Lower => True);
3232 Notes.Table (Notes.Last).Pragma_Source_File :=
3233 Units.Table (Units.Last).Sfile;
3237 Notes.Table (Notes.Last).Pragma_Args := No_Name;
3240 -- Note: can't use Get_Name here as the remainder of the
3241 -- line is unstructured text whose syntax depends on the
3242 -- particular pragma used.
3247 while not At_Eol loop
3248 Add_Char_To_Name_Buffer (Getc);
3256 end loop Notes_Loop;
3259 -- End loop through units for one ALI file
3261 ALIs.Table (Id).Last_Unit := Units.Last;
3262 ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
3264 -- Set types of the units (there can be at most 2 of them)
3266 if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
3267 Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
3268 Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
3271 -- Deal with body only and spec only cases, note that the reason we
3272 -- do our own checking of the name (rather than using Is_Body_Name)
3273 -- is that Uname drags in far too much compiler junk.
3275 Get_Name_String (Units.Table (Units.Last).Uname);
3277 if Name_Buffer (Name_Len) = 'b' then
3278 Units.Table (Units.Last).Utype := Is_Body_Only;
3280 Units.Table (Units.Last).Utype := Is_Spec_Only;
3284 -- Scan out external version references and put in hash table
3288 exit E_Loop when C /= 'E';
3290 if Ignore ('E') then
3306 exit when At_End_Of_Field;
3307 Add_Char_To_Name_Buffer (C);
3310 Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
3317 -- Scan out source dependency lines for this ALI file
3319 ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
3323 exit D_Loop when C /= 'D';
3325 if Ignore ('D') then
3331 Sdep.Increment_Last;
3333 -- In the following call, Lower is not set to True, this is either
3334 -- a bug, or it deserves a special comment as to why this is so???
3336 -- The file/path name may be quoted
3338 Sdep.Table (Sdep.Last).Sfile :=
3339 Get_File_Name (May_Be_Quoted => True);
3341 Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
3342 Sdep.Table (Sdep.Last).Dummy_Entry :=
3343 (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
3345 -- Acquire checksum value
3358 exit when At_Eol or else Ctr = 8;
3360 if Nextc in '0' .. '9' then
3362 Character'Pos (Nextc) - Character'Pos ('0');
3364 elsif Nextc in 'a' .. 'f' then
3366 Character'Pos (Nextc) - Character'Pos ('a') + 10;
3376 if Ctr = 8 and then At_End_Of_Field then
3377 Sdep.Table (Sdep.Last).Checksum := Chk;
3383 -- Acquire (sub)unit and reference file name entries
3385 Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
3386 Sdep.Table (Sdep.Last).Unit_Name := No_Name;
3387 Sdep.Table (Sdep.Last).Rfile :=
3388 Sdep.Table (Sdep.Last).Sfile;
3389 Sdep.Table (Sdep.Last).Start_Line := 1;
3394 -- Here for (sub)unit name
3396 if Nextc not in '0' .. '9' then
3398 while not At_End_Of_Field loop
3399 Add_Char_To_Name_Buffer (Getc);
3402 -- Set the (sub)unit name. Note that we use Name_Find rather
3403 -- than Name_Enter here as the subunit name may already
3404 -- have been put in the name table by the Project Manager.
3407 or else Name_Buffer (Name_Len - 1) /= '%'
3409 Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
3411 Name_Len := Name_Len - 2;
3412 Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
3418 -- Here for reference file name entry
3420 if Nextc in '0' .. '9' then
3421 Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
3426 while not At_End_Of_Field loop
3427 Add_Char_To_Name_Buffer (Getc);
3430 Sdep.Table (Sdep.Last).Rfile := Name_Enter;
3440 ALIs.Table (Id).Last_Sdep := Sdep.Last;
3442 -- Loop through invocation-graph lines
3446 exit G_Loop when C /= 'G';
3448 Scan_Invocation_Graph_Line;
3453 -- We must at this stage be at an Xref line or the end of file
3465 -- If we are ignoring Xref sections we are done (we ignore all
3466 -- remaining lines since only xref related lines follow X).
3468 if Ignore ('X') and then not Debug_Flag_X then
3472 -- Loop through Xref sections
3476 exit X_Loop when C /= 'X';
3478 -- Make new entry in section table
3480 Xref_Section.Increment_Last;
3482 Read_Refs_For_One_File : declare
3483 XS : Xref_Section_Record renames
3484 Xref_Section.Table (Xref_Section.Last);
3486 Current_File_Num : Sdep_Id;
3487 -- Keeps track of the current file number (changed by nn|)
3490 XS.File_Num := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
3491 XS.File_Name := Get_File_Name;
3492 XS.First_Entity := Xref_Entity.Last + 1;
3494 Current_File_Num := XS.File_Num;
3501 -- Loop through Xref entities
3503 while C /= 'X' and then C /= EOF loop
3504 Xref_Entity.Increment_Last;
3506 Read_Refs_For_One_Entity : declare
3507 XE : Xref_Entity_Record renames
3508 Xref_Entity.Table (Xref_Entity.Last);
3511 procedure Read_Instantiation_Reference;
3512 -- Acquire instantiation reference. Caller has checked
3513 -- that current character is '[' and on return the cursor
3514 -- is skipped past the corresponding closing ']'.
3516 ----------------------------------
3517 -- Read_Instantiation_Reference --
3518 ----------------------------------
3520 procedure Read_Instantiation_Reference is
3521 Local_File_Num : Sdep_Id := Current_File_Num;
3524 Xref.Increment_Last;
3527 XR : Xref_Record renames Xref.Table (Xref.Last);
3530 P := P + 1; -- skip [
3535 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
3536 Local_File_Num := XR.File_Num;
3541 XR.File_Num := Local_File_Num;
3548 -- Recursive call for next reference
3551 pragma Warnings (Off); -- kill recursion warning
3552 Read_Instantiation_Reference;
3553 pragma Warnings (On);
3556 -- Skip closing bracket after recursive call
3560 end Read_Instantiation_Reference;
3562 -- Start of processing for Read_Refs_For_One_Entity
3571 XE.Visibility := Global;
3573 XE.Visibility := Static;
3575 XE.Visibility := Other;
3578 XE.Entity := Get_Name;
3580 -- Handle the information about generic instantiations
3583 Skipc; -- Opening '['
3586 if Nextc /= '|' then
3587 XE.Iref_File_Num := Current_File_Num;
3591 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
3593 XE.Iref_Line := Get_Nat;
3601 XE.Iref_File_Num := No_Sdep_Id;
3605 Current_File_Num := XS.File_Num;
3607 -- Renaming reference is present
3611 XE.Rref_Line := Get_Nat;
3617 XE.Rref_Col := Get_Nat;
3619 -- No renaming reference present
3628 XE.Oref_File_Num := No_Sdep_Id;
3629 XE.Tref_File_Num := No_Sdep_Id;
3630 XE.Tref := Tref_None;
3631 XE.First_Xref := Xref.Last + 1;
3633 -- Loop to check for additional info present
3646 (Current_File_Num, Ref, File, Line, Typ, Col, Std);
3647 exit when Ref = Tref_None;
3649 -- Do we have an overriding procedure?
3651 if Ref = Tref_Derived and then Typ = 'p' then
3652 XE.Oref_File_Num := File;
3653 XE.Oref_Line := Line;
3656 -- Arrays never override anything, and <> points to
3657 -- the index types instead
3659 elsif Ref = Tref_Derived and then XE.Etype = 'A' then
3661 -- Index types are stored in the list of references
3663 Xref.Increment_Last;
3666 XR : Xref_Record renames Xref.Table (Xref.Last);
3668 XR.File_Num := File;
3670 XR.Rtype := Array_Index_Reference;
3675 -- Interfaces are stored in the list of references,
3676 -- although the parent type itself is stored in XE.
3677 -- The first interface (when there are only
3678 -- interfaces) is stored in XE.Tref*)
3680 elsif Ref = Tref_Derived
3682 and then XE.Tref_File_Num /= No_Sdep_Id
3684 Xref.Increment_Last;
3687 XR : Xref_Record renames Xref.Table (Xref.Last);
3689 XR.File_Num := File;
3691 XR.Rtype := Interface_Reference;
3698 XE.Tref_File_Num := File;
3699 XE.Tref_Line := Line;
3700 XE.Tref_Type := Typ;
3702 XE.Tref_Standard_Entity := Std;
3707 -- Loop through cross-references for this entity
3714 exit when Nextc /= '.';
3718 Xref.Increment_Last;
3721 XR : Xref_Record renames Xref.Table (Xref.Last);
3728 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
3729 Current_File_Num := XR.File_Num;
3733 XR.File_Num := Current_File_Num;
3739 -- Imported entities reference as in:
3740 -- 494b<c,__gnat_copy_attribs>25
3744 XR.Imported_Lang := Get_Name;
3746 pragma Assert (Nextc = ',');
3749 XR.Imported_Name := Get_Name;
3751 pragma Assert (Nextc = '>');
3755 XR.Imported_Lang := No_Name;
3756 XR.Imported_Name := No_Name;
3762 Read_Instantiation_Reference;
3767 -- Record last cross-reference
3769 XE.Last_Xref := Xref.Last;
3773 when Bad_ALI_Format =>
3775 -- If ignoring errors, then we skip a line with an
3776 -- unexpected error, and try to continue subsequent
3779 if Ignore_Errors then
3780 Xref_Entity.Decrement_Last;
3784 -- Otherwise, we reraise the fatal exception
3789 end Read_Refs_For_One_Entity;
3792 -- Record last entity
3794 XS.Last_Entity := Xref_Entity.Last;
3795 end Read_Refs_For_One_File;
3800 -- Here after dealing with xref sections
3802 -- Ignore remaining lines, which belong to an additional section of the
3803 -- ALI file not considered here (like SCO or SPARK information).
3810 when Bad_ALI_Format =>
3818 function Scope (IS_Id : Invocation_Signature_Id) return Name_Id is
3820 pragma Assert (Present (IS_Id));
3821 return Invocation_Signatures.Table (IS_Id).Scope;
3828 function SEq (F1, F2 : String_Ptr) return Boolean is
3830 return F1.all = F2.all;
3833 -----------------------------------
3834 -- Set_Invocation_Graph_Encoding --
3835 -----------------------------------
3837 procedure Set_Invocation_Graph_Encoding
3838 (Kind : Invocation_Graph_Encoding_Kind;
3839 Update_Units : Boolean := True)
3842 Compile_Time_Invocation_Graph_Encoding := Kind;
3844 -- Update the invocation-graph encoding of the current unit only when
3845 -- requested by the caller.
3847 if Update_Units then
3849 Curr_Unit : Unit_Record renames Units.Table (Units.Last);
3850 Curr_ALI : ALIs_Record renames ALIs.Table (Curr_Unit.My_ALI);
3853 Curr_ALI.Invocation_Graph_Encoding := Kind;
3856 end Set_Invocation_Graph_Encoding;
3862 function SHash (S : String_Ptr) return Vindex is
3867 for J in S.all'Range loop
3868 H := H * 2 + Character'Pos (S (J));
3871 return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
3879 (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id
3882 pragma Assert (Present (IC_Id));
3883 return Invocation_Constructs.Table (IC_Id).Signature;
3886 --------------------
3887 -- Spec_Placement --
3888 --------------------
3890 function Spec_Placement
3891 (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
3894 pragma Assert (Present (IC_Id));
3895 return Invocation_Constructs.Table (IC_Id).Spec_Placement;
3903 (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
3906 pragma Assert (Present (IR_Id));
3907 return Invocation_Relations.Table (IR_Id).Target;