1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2018, 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
;
36 -- Make control characters visible
38 -- The following variable records which characters currently are used as
39 -- line type markers in the ALI file. This is used in Scan_ALI to detect
40 -- (or skip) invalid lines. The following letters are still available:
44 Known_ALI_Lines
: constant array (Character range 'A' .. 'Z') of Boolean :=
45 ('V' => True, -- version
46 'M' => True, -- main program
47 'A' => True, -- argument
48 'P' => True, -- program
49 'R' => True, -- restriction
50 'I' => True, -- interrupt
53 'L' => True, -- linker option
55 'E' => True, -- external
56 'D' => True, -- dependency
58 'S' => True, -- specific dispatching
59 'Y' => True, -- limited_with
60 'Z' => True, -- implicit with from instantiation
61 'C' => True, -- SCO information
62 'F' => True, -- SPARK cross-reference information
63 'T' => True, -- task stack information
70 procedure Initialize_ALI
is
72 -- When (re)initializing ALI data structures the ALI user expects to
73 -- get a fresh set of data structures. Thus we first need to erase the
74 -- marks put in the name table by the previous set of ALI routine calls.
75 -- These two loops are empty and harmless the first time in.
77 for J
in ALIs
.First
.. ALIs
.Last
loop
78 Set_Name_Table_Int
(ALIs
.Table
(J
).Afile
, 0);
81 for J
in Units
.First
.. Units
.Last
loop
82 Set_Name_Table_Int
(Units
.Table
(J
).Uname
, 0);
85 -- Free argument table strings
87 for J
in Args
.First
.. Args
.Last
loop
88 Free
(Args
.Table
(J
));
91 -- Initialize all tables
105 -- Add dummy zero'th item in Linker_Options and Notes for sort calls
107 Linker_Options
.Increment_Last
;
108 Notes
.Increment_Last
;
110 -- Initialize global variables recording cumulative options in all
111 -- ALI files that are read for a given processing run in gnatbind.
113 Dynamic_Elaboration_Checks_Specified
:= False;
114 Locking_Policy_Specified
:= ' ';
115 No_Normalize_Scalars_Specified
:= False;
116 No_Object_Specified
:= False;
117 No_Component_Reordering_Specified
:= False;
118 GNATprove_Mode_Specified
:= False;
119 Normalize_Scalars_Specified
:= False;
120 Partition_Elaboration_Policy_Specified
:= ' ';
121 Queuing_Policy_Specified
:= ' ';
122 SSO_Default_Specified
:= False;
123 Task_Dispatching_Policy_Specified
:= ' ';
124 Unreserve_All_Interrupts_Specified
:= False;
125 Frontend_Exceptions_Specified
:= False;
126 Zero_Cost_Exceptions_Specified
:= False;
138 Read_Xref
: Boolean := False;
139 Read_Lines
: String := "";
140 Ignore_Lines
: String := "X";
141 Ignore_Errors
: Boolean := False;
142 Directly_Scanned
: Boolean := False) return ALI_Id
144 P
: Text_Ptr
:= T
'First;
145 Line
: Logical_Line_Number
:= 1;
151 Ignore
: array (Character range 'A' .. 'Z') of Boolean;
152 -- Ignore (X) is set to True if lines starting with X are to
153 -- be ignored by Scan_ALI and skipped, and False if the lines
154 -- are to be read and processed.
156 Bad_ALI_Format
: exception;
157 -- Exception raised by Fatal_Error if Err is True
159 function At_Eol
return Boolean;
160 -- Test if at end of line
162 function At_End_Of_Field
return Boolean;
163 -- Test if at end of line, or if at blank or horizontal tab
165 procedure Check_At_End_Of_Field
;
166 -- Check if we are at end of field, fatal error if not
168 procedure Checkc
(C
: Character);
169 -- Check next character is C. If so bump past it, if not fatal error
171 procedure Check_Unknown_Line
;
172 -- If Ignore_Errors mode, then checks C to make sure that it is not
173 -- an unknown ALI line type characters, and if so, skips lines
174 -- until the first character of the line is one of these characters,
175 -- at which point it does a Getc to put that character in C. The
176 -- call has no effect if C is already an appropriate character.
177 -- If not in Ignore_Errors mode, a fatal error is signalled if the
178 -- line is unknown. Note that if C is an EOL on entry, the line is
179 -- skipped (it is assumed that blank lines are never significant).
180 -- If C is EOF on entry, the call has no effect (it is assumed that
181 -- the caller will properly handle this case).
183 procedure Fatal_Error
;
184 -- Generate fatal error message for badly formatted ALI file if
185 -- Err is false, or raise Bad_ALI_Format if Err is True.
187 procedure Fatal_Error_Ignore
;
188 pragma Inline
(Fatal_Error_Ignore
);
189 -- In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
191 function Getc
return Character;
192 -- Get next character, bumping P past the character obtained
194 function Get_File_Name
195 (Lower
: Boolean := False;
196 May_Be_Quoted
: Boolean := False) return File_Name_Type
;
197 -- Skip blanks, then scan out a file name (name is left in Name_Buffer
198 -- with length in Name_Len, as well as returning a File_Name_Type value.
199 -- If May_Be_Quoted is True and the first non blank character is '"',
200 -- then remove starting and ending quotes and undoubled internal quotes.
201 -- If lower is false, the case is unchanged, if Lower is True then the
202 -- result is forced to all lower case for systems where file names are
203 -- not case sensitive. This ensures that gnatbind works correctly
204 -- regardless of the case of the file name on all systems. The scan
205 -- is terminated by a end of line, space or horizontal tab. Any other
206 -- special characters are included in the returned name.
209 (Ignore_Spaces
: Boolean := False;
210 Ignore_Special
: Boolean := False;
211 May_Be_Quoted
: Boolean := False) return Name_Id
;
212 -- Skip blanks, then scan out a name (name is left in Name_Buffer with
213 -- length in Name_Len, as well as being returned in Name_Id form).
214 -- If Lower is set to True then the Name_Buffer will be converted to
215 -- all lower case, for systems where file names are not case sensitive.
216 -- This ensures that gnatbind works correctly regardless of the case
217 -- of the file name on all systems. The termination condition depends
218 -- on the settings of Ignore_Spaces and Ignore_Special:
220 -- If Ignore_Spaces is False (normal case), then scan is terminated
221 -- by the normal end of field condition (EOL, space, horizontal tab)
223 -- If Ignore_Special is False (normal case), the scan is terminated by
224 -- a typeref bracket or an equal sign except for the special case of
225 -- an operator name starting with a double quote which is terminated
226 -- by another double quote.
228 -- If May_Be_Quoted is True and the first non blank character is '"'
229 -- the name is 'unquoted'. In this case Ignore_Special is ignored and
230 -- assumed to be True.
232 -- It is an error to set both Ignore_Spaces and Ignore_Special to True.
233 -- This function handles wide characters properly.
235 function Get_Nat
return Nat
;
236 -- Skip blanks, then scan out an unsigned integer value in Nat range
237 -- raises ALI_Reading_Error if the encoutered type is not natural.
239 function Get_Stamp
return Time_Stamp_Type
;
240 -- Skip blanks, then scan out a time stamp
242 function Get_Unit_Name
return Unit_Name_Type
;
243 -- Skip blanks, then scan out a file name (name is left in Name_Buffer
244 -- with length in Name_Len, as well as returning a Unit_Name_Type value.
245 -- The case is unchanged and terminated by a normal end of field.
247 function Nextc
return Character;
248 -- Return current character without modifying pointer P
250 procedure Get_Typeref
251 (Current_File_Num
: Sdep_Id
;
253 File_Num
: out Sdep_Id
;
255 Ref_Type
: out Character;
257 Standard_Entity
: out Name_Id
);
258 -- Parse the definition of a typeref (<...>, {...} or (...))
261 -- Skip past spaces, then skip past end of line (fatal error if not
262 -- at end of line). Also skips past any following blank lines.
265 -- Skip rest of current line and any following blank lines
267 procedure Skip_Space
;
268 -- Skip past white space (blanks or horizontal tab)
271 -- Skip past next character, does not affect value in C. This call
272 -- is like calling Getc and ignoring the returned result.
274 ---------------------
275 -- At_End_Of_Field --
276 ---------------------
278 function At_End_Of_Field
return Boolean is
287 function At_Eol
return Boolean is
289 return Nextc
= EOF
or else Nextc
= CR
or else Nextc
= LF
;
292 ---------------------------
293 -- Check_At_End_Of_Field --
294 ---------------------------
296 procedure Check_At_End_Of_Field
is
298 if not At_End_Of_Field
then
299 if Ignore_Errors
then
300 while Nextc
> ' ' loop
307 end Check_At_End_Of_Field
;
309 ------------------------
310 -- Check_Unknown_Line --
311 ------------------------
313 procedure Check_Unknown_Line
is
315 while C
not in 'A' .. 'Z'
316 or else not Known_ALI_Lines
(C
)
318 if C
= CR
or else C
= LF
then
325 elsif Ignore_Errors
then
333 end Check_Unknown_Line
;
339 procedure Checkc
(C
: Character) is
343 elsif Ignore_Errors
then
354 procedure Fatal_Error
is
359 procedure Wchar
(C
: Character);
360 -- Write a single character, replacing horizontal tab by spaces
362 procedure Wchar
(C
: Character) is
367 exit when Col
mod 8 = 0;
376 -- Start of processing for Fatal_Error
380 raise Bad_ALI_Format
;
384 Write_Str
("fatal error: file ");
386 Write_Str
(" is incorrectly formatted");
389 Write_Str
("make sure you are using consistent versions " &
391 -- Split the following line so that it can easily be transformed for
392 -- other back-ends where the compiler might have a different name.
398 -- Find start of line
402 and then T
(Ptr1
- 1) /= CR
403 and then T
(Ptr1
- 1) /= LF
408 Write_Int
(Int
(Line
));
423 and then T
(Ptr2
) /= CR
424 and then T
(Ptr2
) /= LF
436 if T
(Ptr1
) = HT
then
448 Exit_Program
(E_Fatal
);
451 ------------------------
452 -- Fatal_Error_Ignore --
453 ------------------------
455 procedure Fatal_Error_Ignore
is
457 if not Ignore_Errors
then
460 end Fatal_Error_Ignore
;
466 function Get_File_Name
467 (Lower
: Boolean := False;
468 May_Be_Quoted
: Boolean := False) return File_Name_Type
473 F
:= Get_Name
(Ignore_Special
=> True,
474 May_Be_Quoted
=> May_Be_Quoted
);
476 -- Convert file name to all lower case if file names are not case
477 -- sensitive. This ensures that we handle names in the canonical
478 -- lower case format, regardless of the actual case.
480 if Lower
and not File_Names_Case_Sensitive
then
481 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
484 return File_Name_Type
(F
);
493 (Ignore_Spaces
: Boolean := False;
494 Ignore_Special
: Boolean := False;
495 May_Be_Quoted
: Boolean := False) return Name_Id
504 if Ignore_Errors
then
513 -- Deal with quoted characters
515 if May_Be_Quoted
and then Char
= '"' then
518 if Ignore_Errors
then
541 Add_Char_To_Name_Buffer
(Char
);
544 -- Other than case of quoted character
549 Add_Char_To_Name_Buffer
(Getc
);
551 exit when At_End_Of_Field
and then not Ignore_Spaces
;
553 if not Ignore_Special
then
554 if Name_Buffer
(1) = '"' then
555 exit when Name_Len
> 1
556 and then Name_Buffer
(Name_Len
) = '"';
559 -- Terminate on parens or angle brackets or equal sign
561 exit when Nextc
= '(' or else Nextc
= ')'
562 or else Nextc
= '{' or else Nextc
= '}'
563 or else Nextc
= '<' or else Nextc
= '>'
566 -- Terminate on comma
568 exit when Nextc
= ',';
570 -- Terminate if left bracket not part of wide char
571 -- sequence Note that we only recognize brackets
572 -- notation so far ???
574 exit when Nextc
= '[' and then T
(P
+ 1) /= '"';
576 -- Terminate if right bracket not part of wide char
579 exit when Nextc
= ']' and then T
(P
- 1) /= '"';
592 function Get_Unit_Name
return Unit_Name_Type
is
594 return Unit_Name_Type
(Get_Name
);
601 function Get_Nat
return Nat
is
607 -- Check if we are on a number. In the case of bad ALI files, this
610 if not (Nextc
in '0' .. '9') then
616 V
:= V
* 10 + (Character'Pos (Getc
) - Character'Pos ('0'));
618 exit when At_End_Of_Field
;
619 exit when Nextc
< '0' or else Nextc
> '9';
629 function Get_Stamp
return Time_Stamp_Type
is
637 if Ignore_Errors
then
638 return Dummy_Time_Stamp
;
644 -- Following reads old style time stamp missing first two digits
646 if Nextc
in '7' .. '9' then
651 -- Normal case of full year in time stamp
657 for J
in Start
.. T
'Last loop
668 procedure Get_Typeref
669 (Current_File_Num
: Sdep_Id
;
671 File_Num
: out Sdep_Id
;
673 Ref_Type
: out Character;
675 Standard_Entity
: out Name_Id
)
680 when '<' => Ref
:= Tref_Derived
;
681 when '(' => Ref
:= Tref_Access
;
682 when '{' => Ref
:= Tref_Type
;
683 when others => Ref
:= Tref_None
;
686 -- Case of typeref field present
688 if Ref
/= Tref_None
then
689 P
:= P
+ 1; -- skip opening bracket
691 if Nextc
in 'a' .. 'z' then
692 File_Num
:= No_Sdep_Id
;
696 Standard_Entity
:= Get_Name
(Ignore_Spaces
=> True);
701 File_Num
:= Sdep_Id
(N
+ Nat
(First_Sdep_Entry
) - 1);
705 File_Num
:= Current_File_Num
;
711 Standard_Entity
:= No_Name
;
714 -- ??? Temporary workaround for nested generics case:
715 -- 4i4 Directories{1|4I9[4|6[3|3]]}
719 Nested_Brackets
: Natural := 0;
725 Nested_Brackets
:= Nested_Brackets
+ 1;
727 Nested_Brackets
:= Nested_Brackets
- 1;
729 if Nested_Brackets
= 0 then
738 P
:= P
+ 1; -- skip closing bracket
741 -- No typeref entry present
744 File_Num
:= No_Sdep_Id
;
748 Standard_Entity
:= No_Name
;
756 function Getc
return Character is
770 function Nextc
return Character is
779 procedure Skip_Eol
is
784 if Ignore_Errors
then
785 while not At_Eol
loop
793 -- Loop to skip past blank lines (first time through skips this EOL)
795 while Nextc
< ' ' and then Nextc
/= EOF
loop
808 procedure Skip_Line
is
810 while not At_Eol
loop
821 procedure Skip_Space
is
823 while Nextc
= ' ' or else Nextc
= HT
loop
839 -- Start of processing for Scan_ALI
842 First_Sdep_Entry
:= Sdep
.Last
+ 1;
844 -- Acquire lines to be ignored
848 ('T' |
'U' |
'W' |
'Y' |
'Z' |
'D' |
'X' => False, others => True);
850 -- Read_Lines parameter given
852 elsif Read_Lines
/= "" then
853 Ignore
:= ('U' => False, others => True);
855 for J
in Read_Lines
'Range loop
856 Ignore
(Read_Lines
(J
)) := False;
859 -- Process Ignore_Lines parameter
862 Ignore
:= (others => False);
864 for J
in Ignore_Lines
'Range loop
865 pragma Assert
(Ignore_Lines
(J
) /= 'U');
866 Ignore
(Ignore_Lines
(J
)) := True;
870 -- Setup ALI Table entry with appropriate defaults
874 Set_Name_Table_Int
(F
, Int
(Id
));
878 Compile_Errors
=> False,
879 First_Interrupt_State
=> Interrupt_States
.Last
+ 1,
880 First_Sdep
=> No_Sdep_Id
,
881 First_Specific_Dispatching
=> Specific_Dispatching
.Last
+ 1,
882 First_Unit
=> No_Unit_Id
,
883 GNATprove_Mode
=> False,
884 Last_Interrupt_State
=> Interrupt_States
.Last
,
885 Last_Sdep
=> No_Sdep_Id
,
886 Last_Specific_Dispatching
=> Specific_Dispatching
.Last
,
887 Last_Unit
=> No_Unit_Id
,
888 Locking_Policy
=> ' ',
891 Main_Program
=> None
,
892 No_Component_Reordering
=> False,
894 Normalize_Scalars
=> False,
895 Ofile_Full_Name
=> Full_Object_File_Name
,
896 Partition_Elaboration_Policy
=> ' ',
897 Queuing_Policy
=> ' ',
898 Restrictions
=> No_Restrictions
,
899 SAL_Interface
=> False,
902 Task_Dispatching_Policy
=> ' ',
903 Time_Slice_Value
=> -1,
905 Unit_Exception_Table
=> False,
906 Ver
=> (others => ' '),
908 Frontend_Exceptions
=> False,
909 Zero_Cost_Exceptions
=> False);
911 -- Now we acquire the input lines from the ALI file. Note that the
912 -- convention in the following code is that as we enter each section,
913 -- C is set to contain the first character of the following line.
918 -- Acquire library version
922 -- The V line missing really indicates trouble, most likely it
923 -- means we don't have an ALI file at all, so here we give a
924 -- fatal error even if we are in Ignore_Errors mode.
928 elsif Ignore
('V') then
936 for J
in 1 .. Ver_Len_Max
loop
939 ALIs
.Table
(Id
).Ver
(J
) := C
;
940 ALIs
.Table
(Id
).Ver_Len
:= J
;
949 -- Acquire main program line if present
962 ALIs
.Table
(Id
).Main_Program
:= Func
;
964 ALIs
.Table
(Id
).Main_Program
:= Proc
;
974 ALIs
.Table
(Id
).Main_Priority
:= Get_Nat
;
982 ALIs
.Table
(Id
).Time_Slice_Value
:= Get_Nat
;
990 ALIs
.Table
(Id
).Main_CPU
:= Get_Nat
;
997 ALIs
.Table
(Id
).WC_Encoding
:= Getc
;
1006 -- Acquire argument lines
1008 First_Arg
:= Args
.Last
+ 1;
1012 exit A_Loop
when C
/= 'A';
1014 if Ignore
('A') then
1020 -- Scan out argument
1023 while not At_Eol
loop
1024 Add_Char_To_Name_Buffer
(Getc
);
1027 -- If -fstack-check, record that it occurred. Note that an
1028 -- additional string parameter can be specified, in the form of
1029 -- -fstack-check={no|generic|specific}. "no" means no checking,
1030 -- "generic" means force the use of old-style checking, and
1031 -- "specific" means use the best checking method.
1034 and then Name_Buffer
(1 .. 13) = "-fstack-check"
1035 and then Name_Buffer
(1 .. Name_Len
) /= "-fstack-check=no"
1037 Stack_Check_Switch_Set
:= True;
1040 -- Store the argument
1042 Args
.Increment_Last
;
1043 Args
.Table
(Args
.Last
) := new String'(Name_Buffer (1 .. Name_Len));
1056 if Ignore_Errors then
1068 if Ignore ('P
') then
1076 while not At_Eol loop
1081 -- Processing for CE
1085 ALIs.Table (Id).Compile_Errors := True;
1087 -- Processing for DB
1091 Detect_Blocking := True;
1093 -- Processing for Ex
1096 Partition_Elaboration_Policy_Specified := Getc;
1097 ALIs.Table (Id).Partition_Elaboration_Policy :=
1098 Partition_Elaboration_Policy_Specified;
1100 -- Processing for FX
1106 ALIs.Table (Id).Frontend_Exceptions := True;
1107 Frontend_Exceptions_Specified := True;
1112 -- Processing for GP
1116 GNATprove_Mode_Specified := True;
1117 ALIs.Table (Id).GNATprove_Mode := True;
1119 -- Processing for Lx
1122 Locking_Policy_Specified := Getc;
1123 ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
1125 -- Processing for flags starting with N
1130 -- Processing for NC
1133 ALIs.Table (Id).No_Component_Reordering := True;
1134 No_Component_Reordering_Specified := True;
1136 -- Processing for NO
1139 ALIs.Table (Id).No_Object := True;
1140 No_Object_Specified := True;
1142 -- Processing for NR
1145 No_Run_Time_Mode := True;
1146 Configurable_Run_Time_Mode := True;
1148 -- Processing for NS
1151 ALIs.Table (Id).Normalize_Scalars := True;
1152 Normalize_Scalars_Specified := True;
1155 -- Invalid switch starting with N
1161 -- Processing for OH/OL
1166 if C = 'L
' or else C = 'H
' then
1167 ALIs.Table (Id).SSO_Default := C;
1168 SSO_Default_Specified := True;
1174 -- Processing for Qx
1177 Queuing_Policy_Specified := Getc;
1178 ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
1180 -- Processing for flags starting with S
1185 -- Processing for SL
1188 ALIs.Table (Id).SAL_Interface := True;
1190 -- Processing for SS
1193 Opt.Sec_Stack_Used := True;
1195 -- Invalid switch starting with S
1201 -- Processing for Tx
1204 Task_Dispatching_Policy_Specified := Getc;
1205 ALIs.Table (Id).Task_Dispatching_Policy :=
1206 Task_Dispatching_Policy_Specified;
1208 -- Processing for switch starting with U
1213 -- Processing for UA
1216 Unreserve_All_Interrupts_Specified := True;
1218 -- Processing for UX
1221 ALIs.Table (Id).Unit_Exception_Table := True;
1223 -- Invalid switches starting with U
1229 -- Processing for ZX
1235 ALIs.Table (Id).Zero_Cost_Exceptions := True;
1236 Zero_Cost_Exceptions_Specified := True;
1241 -- Invalid parameter
1249 if not NS_Found then
1250 No_Normalize_Scalars_Specified := True;
1259 -- Loop to skip to first restrictions line
1262 if Ignore_Errors then
1274 -- Ignore all 'R
' lines if that is required
1276 if Ignore ('R
') then
1282 -- Here we process the restrictions lines (other than unit name cases)
1285 Scan_Restrictions : declare
1286 Save_R : constant Restrictions_Info := Cumulative_Restrictions;
1287 -- Save cumulative restrictions in case we have a fatal error
1289 Bad_R_Line : exception;
1290 -- Signal bad restrictions line (raised on unexpected character)
1297 -- Named restriction case
1303 -- Loop through RR and RV lines
1305 while C = 'R
' and then Nextc /= ' ' loop
1309 -- Acquire restriction name
1312 while not At_Eol and then Nextc /= '=' loop
1313 Name_Len := Name_Len + 1;
1314 Name_Buffer (Name_Len) := Getc;
1317 -- Now search list of restrictions to find match
1320 RN : String renames Name_Buffer (1 .. Name_Len);
1323 R := Restriction_Id'First;
1324 while R /= Not_A_Restriction_Id loop
1325 if Restriction_Id'Image (R) = RN then
1329 R := Restriction_Id'Succ (R);
1332 -- We don't recognize the restriction. This might be
1333 -- thought of as an error, and it really is, but we
1334 -- want to allow building with inconsistent versions
1335 -- of the binder and ali files (see comments at the
1336 -- start of package System.Rident), so we just ignore
1339 goto Done_With_Restriction_Line;
1346 -- Boolean restriction case
1348 when All_Boolean_Restrictions =>
1351 ALIs.Table (Id).Restrictions.Violated (R) :=
1353 Cumulative_Restrictions.Violated (R) := True;
1356 ALIs.Table (Id).Restrictions.Set (R) := True;
1357 Cumulative_Restrictions.Set (R) := True;
1363 -- Parameter restriction case
1365 when All_Parameter_Restrictions =>
1366 if At_Eol or else Nextc /= '=' then
1372 N := Natural (Get_Nat);
1379 ALIs.Table (Id).Restrictions.Set (R) := True;
1380 ALIs.Table (Id).Restrictions.Value (R) := N;
1382 if Cumulative_Restrictions.Set (R) then
1383 Cumulative_Restrictions.Value (R) :=
1385 (Cumulative_Restrictions.Value (R), N);
1387 Cumulative_Restrictions.Set (R) := True;
1388 Cumulative_Restrictions.Value (R) := N;
1391 -- Restriction violated
1394 ALIs.Table (Id).Restrictions.Violated (R) :=
1396 Cumulative_Restrictions.Violated (R) := True;
1397 ALIs.Table (Id).Restrictions.Count (R) := N;
1399 -- Checked Max_Parameter case
1401 if R in Checked_Max_Parameter_Restrictions then
1402 Cumulative_Restrictions.Count (R) :=
1404 (Cumulative_Restrictions.Count (R), N);
1406 -- Other checked parameter cases
1410 pragma Unsuppress (Overflow_Check);
1413 Cumulative_Restrictions.Count (R) :=
1414 Cumulative_Restrictions.Count (R) + N;
1417 when Constraint_Error =>
1419 -- A constraint error comes from the
1420 -- addition. We reset to the maximum
1421 -- and indicate that the real value
1424 Cumulative_Restrictions.Value (R) :=
1426 Cumulative_Restrictions.Unknown (R) :=
1435 ALIs.Table (Id).Restrictions.Unknown (R) :=
1437 Cumulative_Restrictions.Unknown (R) := True;
1440 -- Other than 'R
' or 'V
'
1450 -- Bizarre error case NOT_A_RESTRICTION
1452 when Not_A_Restriction_Id =>
1460 <<Done_With_Restriction_Line>>
1465 -- Positional restriction case
1471 -- Acquire information for boolean restrictions
1473 for R in All_Boolean_Restrictions loop
1478 ALIs.Table (Id).Restrictions.Violated (R) := True;
1479 Cumulative_Restrictions.Violated (R) := True;
1482 ALIs.Table (Id).Restrictions.Set (R) := True;
1483 Cumulative_Restrictions.Set (R) := True;
1493 -- Acquire information for parameter restrictions
1495 for RP in All_Parameter_Restrictions loop
1501 ALIs.Table (Id).Restrictions.Set (RP) := True;
1504 N : constant Integer := Integer (Get_Nat);
1506 ALIs.Table (Id).Restrictions.Value (RP) := N;
1508 if Cumulative_Restrictions.Set (RP) then
1509 Cumulative_Restrictions.Value (RP) :=
1511 (Cumulative_Restrictions.Value (RP), N);
1513 Cumulative_Restrictions.Set (RP) := True;
1514 Cumulative_Restrictions.Value (RP) := N;
1522 -- Acquire restrictions violations information
1530 ALIs.Table (Id).Restrictions.Violated (RP) := True;
1531 Cumulative_Restrictions.Violated (RP) := True;
1534 N : constant Integer := Integer (Get_Nat);
1537 ALIs.Table (Id).Restrictions.Count (RP) := N;
1539 if RP in Checked_Max_Parameter_Restrictions then
1540 Cumulative_Restrictions.Count (RP) :=
1542 (Cumulative_Restrictions.Count (RP), N);
1546 pragma Unsuppress (Overflow_Check);
1549 Cumulative_Restrictions.Count (RP) :=
1550 Cumulative_Restrictions.Count (RP) + N;
1553 when Constraint_Error =>
1555 -- A constraint error comes from the add. We
1556 -- reset to the maximum and indicate that the
1557 -- real value is now unknown.
1559 Cumulative_Restrictions.Value (RP) :=
1561 Cumulative_Restrictions.Unknown (RP) := True;
1567 ALIs.Table (Id).Restrictions.Unknown (RP) := True;
1568 Cumulative_Restrictions.Unknown (RP) := True;
1585 -- Here if error during scanning of restrictions line
1590 -- In Ignore_Errors mode, undo any changes to restrictions
1591 -- from this unit, and continue on, skipping remaining R
1592 -- lines for this unit.
1594 if Ignore_Errors then
1595 Cumulative_Restrictions := Save_R;
1596 ALIs.Table (Id).Restrictions := No_Restrictions;
1604 -- In normal mode, this is a fatal error
1609 end Scan_Restrictions;
1612 -- Acquire additional restrictions (No_Dependence) lines if present
1615 if Ignore ('R
') then
1619 No_Deps.Append ((Id, Get_Name));
1626 -- Acquire 'I
' lines if present
1631 if Ignore ('I
') then
1637 I_State : Character;
1646 Interrupt_States.Append (
1647 (Interrupt_Id => Int_Num,
1648 Interrupt_State => I_State,
1649 IS_Pragma_Line => Line_No));
1651 ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
1659 -- Acquire 'S
' lines if present
1664 if Ignore ('S
') then
1680 First_Prio := Get_Nat;
1681 Last_Prio := Get_Nat;
1684 Specific_Dispatching.Append (
1685 (Dispatching_Policy => Policy,
1686 First_Priority => First_Prio,
1687 Last_Priority => Last_Prio,
1688 PSD_Pragma_Line => Line_No));
1690 ALIs.Table (Id).Last_Specific_Dispatching :=
1691 Specific_Dispatching.Last;
1700 -- Loop to acquire unit entries
1704 exit U_Loop when C /= 'U
';
1706 -- Note: as per spec, we never ignore U lines
1710 Units.Increment_Last;
1712 if ALIs.Table (Id).First_Unit = No_Unit_Id then
1713 ALIs.Table (Id).First_Unit := Units.Last;
1717 UL : Unit_Record renames Units.Table (Units.Last);
1720 UL.Uname := Get_Unit_Name;
1721 UL.Predefined := Is_Predefined_Unit;
1722 UL.Internal := Is_Internal_Unit;
1724 UL.Sfile := Get_File_Name (Lower => True);
1726 UL.Preelab := False;
1727 UL.No_Elab := False;
1728 UL.Shared_Passive := False;
1730 UL.Remote_Types := False;
1731 UL.Serious_Errors := False;
1732 UL.Has_RACW := False;
1733 UL.Init_Scalars := False;
1734 UL.Is_Generic := False;
1735 UL.Icasing := Mixed_Case;
1736 UL.Kcasing := All_Lower_Case;
1737 UL.Dynamic_Elab := False;
1738 UL.Elaborate_Body := False;
1739 UL.Set_Elab_Entity := False;
1740 UL.Version := "00000000";
1741 UL.First_With := Withs.Last + 1;
1742 UL.First_Arg := First_Arg;
1743 UL.Elab_Position := 0;
1744 UL.SAL_Interface := ALIs.Table (Id).SAL_Interface;
1745 UL.Directly_Scanned := Directly_Scanned;
1746 UL.Body_Needed_For_SAL := False;
1747 UL.Elaborate_Body_Desirable := False;
1748 UL.Optimize_Alignment := 'O
';
1749 UL.Has_Finalizer := False;
1750 UL.Primary_Stack_Count := 0;
1751 UL.Sec_Stack_Count := 0;
1753 if Debug_Flag_U then
1754 Write_Str (" ----> reading unit ");
1755 Write_Int (Int (Units.Last));
1757 Write_Unit_Name (UL.Uname);
1758 Write_Str (" from file ");
1759 Write_Name (UL.Sfile);
1764 -- Check for duplicated unit in different files
1767 Info : constant Int := Get_Name_Table_Int
1768 (Units.Table (Units.Last).Uname);
1771 and then Units.Table (Units.Last).Sfile /=
1772 Units.Table (Unit_Id (Info)).Sfile
1774 -- If Err is set then ignore duplicate unit name. This is the
1775 -- case of a call from gnatmake, where the situation can arise
1776 -- from substitution of source files. In such situations, the
1777 -- processing in gnatmake will always result in any required
1778 -- recompilations in any case, and if we consider this to be
1779 -- an error we get strange cases (for example when a generic
1780 -- instantiation is replaced by a normal package) where we
1781 -- read the old ali file, decide to recompile, and then decide
1782 -- that the old and new ali files are incompatible.
1787 -- If Err is not set, then this is a fatal error. This is
1788 -- the case of being called from the binder, where we must
1789 -- definitely diagnose this as an error.
1793 Write_Str ("error: duplicate unit name: ");
1796 Write_Str ("error: unit """);
1797 Write_Unit_Name (Units.Table (Units.Last).Uname);
1798 Write_Str (""" found in file """);
1799 Write_Name_Decoded (Units.Table (Units.Last).Sfile);
1803 Write_Str ("error
: unit
""");
1804 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1805 Write_Str (""" found
in file
""");
1806 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1810 Exit_Program (E_Fatal);
1816 (Units.Table (Units.Last).Uname, Int (Units.Last));
1818 -- Scan out possible version and other parameters
1827 if C in '0' .. '9' or else C in 'a
' .. 'f
' then
1828 Units.Table (Units.Last).Version (1) := C;
1830 for J in 2 .. 8 loop
1832 Units.Table (Units.Last).Version (J) := C;
1841 Check_At_End_Of_Field;
1842 Units.Table (Units.Last).Elaborate_Body_Desirable := True;
1845 Check_At_End_Of_Field;
1846 Units.Table (Units.Last).Body_Needed_For_SAL := True;
1852 -- DE parameter (Dynamic elaboration checks)
1858 Check_At_End_Of_Field;
1859 Units.Table (Units.Last).Dynamic_Elab := True;
1860 Dynamic_Elaboration_Checks_Specified := True;
1871 Units.Table (Units.Last).Elaborate_Body := True;
1873 Units.Table (Units.Last).Set_Elab_Entity := True;
1878 Check_At_End_Of_Field;
1880 -- GE parameter (generic)
1886 Check_At_End_Of_Field;
1887 Units.Table (Units.Last).Is_Generic := True;
1892 -- IL/IS/IU parameters
1898 Units.Table (Units.Last).Icasing := All_Lower_Case;
1900 Units.Table (Units.Last).Init_Scalars := True;
1901 Initialize_Scalars_Used := True;
1903 Units.Table (Units.Last).Icasing := All_Upper_Case;
1908 Check_At_End_Of_Field;
1916 Units.Table (Units.Last).Kcasing := Mixed_Case;
1918 Units.Table (Units.Last).Kcasing := All_Upper_Case;
1923 Check_At_End_Of_Field;
1931 Units.Table (Units.Last).No_Elab := True;
1932 Check_At_End_Of_Field;
1937 -- PF/PR/PU/PK parameters
1943 Units.Table (Units.Last).Has_Finalizer := True;
1945 Units.Table (Units.Last).Preelab := True;
1947 Units.Table (Units.Last).Pure := True;
1949 Units.Table (Units.Last).Unit_Kind := 'p
';
1954 Check_At_End_Of_Field;
1956 -- OL/OO/OS/OT parameters
1961 if C = 'L
' or else C = 'O
' or else C = 'S
' or else C = 'T
' then
1962 Units.Table (Units.Last).Optimize_Alignment := C;
1967 Check_At_End_Of_Field;
1975 Units.Table (Units.Last).RCI := True;
1977 Units.Table (Units.Last).Remote_Types := True;
1979 Units.Table (Units.Last).Has_RACW := True;
1984 Check_At_End_Of_Field;
1986 -- SE/SP/SU parameters
1992 Units.Table (Units.Last).Serious_Errors := True;
1994 Units.Table (Units.Last).Shared_Passive := True;
1996 Units.Table (Units.Last).Unit_Kind := 's
';
2001 Check_At_End_Of_Field;
2013 -- Scan out With lines for this unit
2017 exit With_Loop when C /= 'W
' and then C /= 'Y
' and then C /= 'Z
';
2019 if Ignore ('W
') then
2025 Withs.Increment_Last;
2026 Withs.Table (Withs.Last).Uname := Get_Unit_Name;
2027 Withs.Table (Withs.Last).Elaborate := False;
2028 Withs.Table (Withs.Last).Elaborate_All := False;
2029 Withs.Table (Withs.Last).Elab_Desirable := False;
2030 Withs.Table (Withs.Last).Elab_All_Desirable := False;
2031 Withs.Table (Withs.Last).SAL_Interface := False;
2032 Withs.Table (Withs.Last).Limited_With := (C = 'Y
');
2033 Withs.Table (Withs.Last).Implicit_With := (C = 'Z
');
2035 -- Generic case with no object file available
2038 Withs.Table (Withs.Last).Sfile := No_File;
2039 Withs.Table (Withs.Last).Afile := No_File;
2044 Withs.Table (Withs.Last).Sfile := Get_File_Name
2046 Withs.Table (Withs.Last).Afile := Get_File_Name
2049 -- Scan out possible E, EA, ED, and AD parameters
2051 while not At_Eol loop
2057 Check_At_End_Of_Field;
2059 -- Store AD indication unless ignore required
2061 if not Ignore_ED then
2062 Withs.Table (Withs.Last).Elab_All_Desirable := True;
2065 elsif Nextc = 'E
' then
2068 if At_End_Of_Field then
2069 Withs.Table (Withs.Last).Elaborate := True;
2071 elsif Nextc = 'A
' then
2073 Check_At_End_Of_Field;
2074 Withs.Table (Withs.Last).Elaborate_All := True;
2078 Check_At_End_Of_Field;
2080 -- Store ED indication unless ignore required
2082 if not Ignore_ED then
2083 Withs.Table (Withs.Last).Elab_Desirable :=
2100 Units.Table (Units.Last).Last_With := Withs.Last;
2101 Units.Table (Units.Last).Last_Arg := Args.Last;
2103 -- Scan out task stack information for the unit if present
2108 if Ignore ('T
') then
2115 Units.Table (Units.Last).Primary_Stack_Count := Get_Nat;
2117 Units.Table (Units.Last).Sec_Stack_Count := Get_Nat;
2125 -- If there are linker options lines present, scan them
2129 Linker_Options_Loop : loop
2131 exit Linker_Options_Loop when C /= 'L
';
2133 if Ignore ('L
') then
2144 if C < Character'Val (16#20#)
2145 or else C > Character'Val (16#7E#)
2150 C := Character'Val (0);
2157 for J in 1 .. 2 loop
2160 if C in '0' .. '9' then
2163 Character'Pos ('0');
2165 elsif C in 'A' .. 'F' then
2168 Character'Pos ('A') +
2177 Add_Char_To_Name_Buffer (Character'Val (V));
2182 exit when Nextc /= '"';
2186 Add_Char_To_Name_Buffer (C);
2190 Add_Char_To_Name_Buffer (NUL);
2195 end loop Linker_Options_Loop;
2197 -- Store the linker options entry if one was found
2199 if Name_Len /= 0 then
2200 Linker_Options.Increment_Last;
2202 Linker_Options.Table (Linker_Options.Last).Name :=
2205 Linker_Options.Table (Linker_Options.Last).Unit :=
2208 Linker_Options.Table (Linker_Options.Last).Internal_File :=
2209 Is_Internal_File_Name (F);
2211 Linker_Options.Table (Linker_Options.Last).Original_Pos :=
2212 Linker_Options.Last;
2215 -- If there are notes present, scan them
2219 exit Notes_Loop when C /= 'N';
2221 if Ignore ('N') then
2227 Notes.Increment_Last;
2228 Notes.Table (Notes.Last).Pragma_Type := Getc;
2229 Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
2231 Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
2233 if not At_Eol and then Nextc = ':' then
2235 Notes.Table (Notes.Last).Pragma_Source_File :=
2236 Get_File_Name (Lower => True);
2238 Notes.Table (Notes.Last).Pragma_Source_File :=
2239 Units.Table (Units.Last).Sfile;
2243 Notes.Table (Notes.Last).Pragma_Args := No_Name;
2246 -- Note: can't use Get_Name here as the remainder of the
2247 -- line is unstructured text whose syntax depends on the
2248 -- particular pragma used.
2253 while not At_Eol loop
2254 Add_Char_To_Name_Buffer (Getc);
2262 end loop Notes_Loop;
2265 -- End loop through units for one ALI file
2267 ALIs.Table (Id).Last_Unit := Units.Last;
2268 ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
2270 -- Set types of the units (there can be at most 2 of them)
2272 if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
2273 Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
2274 Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
2277 -- Deal with body only and spec only cases, note that the reason we
2278 -- do our own checking of the name (rather than using Is_Body_Name)
2279 -- is that Uname drags in far too much compiler junk.
2281 Get_Name_String (Units.Table (Units.Last).Uname);
2283 if Name_Buffer (Name_Len) = 'b' then
2284 Units.Table (Units.Last).Utype := Is_Body_Only;
2286 Units.Table (Units.Last).Utype := Is_Spec_Only;
2290 -- Scan out external version references and put in hash table
2294 exit E_Loop when C /= 'E';
2296 if Ignore ('E') then
2312 exit when At_End_Of_Field;
2313 Add_Char_To_Name_Buffer (C);
2316 Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
2323 -- Scan out source dependency lines for this ALI file
2325 ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
2329 exit D_Loop when C /= 'D';
2331 if Ignore ('D') then
2337 Sdep.Increment_Last;
2339 -- In the following call, Lower is not set to True, this is either
2340 -- a bug, or it deserves a special comment as to why this is so???
2342 -- The file/path name may be quoted
2344 Sdep.Table (Sdep.Last).Sfile :=
2345 Get_File_Name (May_Be_Quoted => True);
2347 Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
2348 Sdep.Table (Sdep.Last).Dummy_Entry :=
2349 (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
2351 -- Acquire checksum value
2364 exit when At_Eol or else Ctr = 8;
2366 if Nextc in '0' .. '9' then
2368 Character'Pos (Nextc) - Character'Pos ('0');
2370 elsif Nextc in 'a' .. 'f' then
2372 Character'Pos (Nextc) - Character'Pos ('a') + 10;
2382 if Ctr = 8 and then At_End_Of_Field then
2383 Sdep.Table (Sdep.Last).Checksum := Chk;
2389 -- Acquire (sub)unit and reference file name entries
2391 Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
2392 Sdep.Table (Sdep.Last).Unit_Name := No_Name;
2393 Sdep.Table (Sdep.Last).Rfile :=
2394 Sdep.Table (Sdep.Last).Sfile;
2395 Sdep.Table (Sdep.Last).Start_Line := 1;
2400 -- Here for (sub)unit name
2402 if Nextc not in '0' .. '9' then
2404 while not At_End_Of_Field loop
2405 Add_Char_To_Name_Buffer (Getc);
2408 -- Set the (sub)unit name. Note that we use Name_Find rather
2409 -- than Name_Enter here as the subunit name may already
2410 -- have been put in the name table by the Project Manager.
2413 or else Name_Buffer (Name_Len - 1) /= '%'
2415 Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
2417 Name_Len := Name_Len - 2;
2418 Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
2424 -- Here for reference file name entry
2426 if Nextc in '0' .. '9' then
2427 Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
2432 while not At_End_Of_Field loop
2433 Add_Char_To_Name_Buffer (Getc);
2436 Sdep.Table (Sdep.Last).Rfile := Name_Enter;
2446 ALIs.Table (Id).Last_Sdep := Sdep.Last;
2448 -- We must at this stage be at an Xref line or the end of file
2460 -- If we are ignoring Xref sections we are done (we ignore all
2461 -- remaining lines since only xref related lines follow X).
2463 if Ignore ('X') and then not Debug_Flag_X then
2467 -- Loop through Xref sections
2471 exit X_Loop when C /= 'X';
2473 -- Make new entry in section table
2475 Xref_Section.Increment_Last;
2477 Read_Refs_For_One_File : declare
2478 XS : Xref_Section_Record renames
2479 Xref_Section.Table (Xref_Section.Last);
2481 Current_File_Num : Sdep_Id;
2482 -- Keeps track of the current file number (changed by nn|)
2485 XS.File_Num := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
2486 XS.File_Name := Get_File_Name;
2487 XS.First_Entity := Xref_Entity.Last + 1;
2489 Current_File_Num := XS.File_Num;
2496 -- Loop through Xref entities
2498 while C /= 'X' and then C /= EOF loop
2499 Xref_Entity.Increment_Last;
2501 Read_Refs_For_One_Entity : declare
2502 XE : Xref_Entity_Record renames
2503 Xref_Entity.Table (Xref_Entity.Last);
2506 procedure Read_Instantiation_Reference;
2507 -- Acquire instantiation reference. Caller has checked
2508 -- that current character is '[' and on return the cursor
2509 -- is skipped past the corresponding closing ']'.
2511 ----------------------------------
2512 -- Read_Instantiation_Reference --
2513 ----------------------------------
2515 procedure Read_Instantiation_Reference is
2516 Local_File_Num : Sdep_Id := Current_File_Num;
2519 Xref.Increment_Last;
2522 XR : Xref_Record renames Xref.Table (Xref.Last);
2525 P := P + 1; -- skip [
2530 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2531 Local_File_Num := XR.File_Num;
2536 XR.File_Num := Local_File_Num;
2543 -- Recursive call for next reference
2546 pragma Warnings (Off); -- kill recursion warning
2547 Read_Instantiation_Reference;
2548 pragma Warnings (On);
2551 -- Skip closing bracket after recursive call
2555 end Read_Instantiation_Reference;
2557 -- Start of processing for Read_Refs_For_One_Entity
2566 XE.Visibility := Global;
2568 XE.Visibility := Static;
2570 XE.Visibility := Other;
2573 XE.Entity := Get_Name;
2575 -- Handle the information about generic instantiations
2578 Skipc; -- Opening '['
2581 if Nextc /= '|' then
2582 XE.Iref_File_Num := Current_File_Num;
2586 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2588 XE.Iref_Line := Get_Nat;
2596 XE.Iref_File_Num := No_Sdep_Id;
2600 Current_File_Num := XS.File_Num;
2602 -- Renaming reference is present
2606 XE.Rref_Line := Get_Nat;
2612 XE.Rref_Col := Get_Nat;
2614 -- No renaming reference present
2623 XE.Oref_File_Num := No_Sdep_Id;
2624 XE.Tref_File_Num := No_Sdep_Id;
2625 XE.Tref := Tref_None;
2626 XE.First_Xref := Xref.Last + 1;
2628 -- Loop to check for additional info present
2641 (Current_File_Num, Ref, File, Line, Typ, Col, Std);
2642 exit when Ref = Tref_None;
2644 -- Do we have an overriding procedure?
2646 if Ref = Tref_Derived and then Typ = 'p' then
2647 XE.Oref_File_Num := File;
2648 XE.Oref_Line := Line;
2651 -- Arrays never override anything, and <> points to
2652 -- the index types instead
2654 elsif Ref = Tref_Derived and then XE.Etype = 'A' then
2656 -- Index types are stored in the list of references
2658 Xref.Increment_Last;
2661 XR : Xref_Record renames Xref.Table (Xref.Last);
2663 XR.File_Num := File;
2665 XR.Rtype := Array_Index_Reference;
2670 -- Interfaces are stored in the list of references,
2671 -- although the parent type itself is stored in XE.
2672 -- The first interface (when there are only
2673 -- interfaces) is stored in XE.Tref*)
2675 elsif Ref = Tref_Derived
2677 and then XE.Tref_File_Num /= No_Sdep_Id
2679 Xref.Increment_Last;
2682 XR : Xref_Record renames Xref.Table (Xref.Last);
2684 XR.File_Num := File;
2686 XR.Rtype := Interface_Reference;
2693 XE.Tref_File_Num := File;
2694 XE.Tref_Line := Line;
2695 XE.Tref_Type := Typ;
2697 XE.Tref_Standard_Entity := Std;
2702 -- Loop through cross-references for this entity
2709 exit when Nextc /= '.';
2713 Xref.Increment_Last;
2716 XR : Xref_Record renames Xref.Table (Xref.Last);
2723 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2724 Current_File_Num := XR.File_Num;
2728 XR.File_Num := Current_File_Num;
2734 -- Imported entities reference as in:
2735 -- 494b<c,__gnat_copy_attribs>25
2739 XR.Imported_Lang := Get_Name;
2741 pragma Assert (Nextc = ',');
2744 XR.Imported_Name := Get_Name;
2746 pragma Assert (Nextc = '>');
2750 XR.Imported_Lang := No_Name;
2751 XR.Imported_Name := No_Name;
2757 Read_Instantiation_Reference;
2762 -- Record last cross-reference
2764 XE.Last_Xref := Xref.Last;
2768 when Bad_ALI_Format =>
2770 -- If ignoring errors, then we skip a line with an
2771 -- unexpected error, and try to continue subsequent
2774 if Ignore_Errors then
2775 Xref_Entity.Decrement_Last;
2779 -- Otherwise, we reraise the fatal exception
2784 end Read_Refs_For_One_Entity;
2787 -- Record last entity
2789 XS.Last_Entity := Xref_Entity.Last;
2791 end Read_Refs_For_One_File;
2796 -- Here after dealing with xref sections
2798 -- Ignore remaining lines, which belong to an additional section of the
2799 -- ALI file not considered here (like SCO or SPARK information).
2806 when Bad_ALI_Format =>
2814 function SEq (F1, F2 : String_Ptr) return Boolean is
2816 return F1.all = F2.all;
2823 function SHash (S : String_Ptr) return Vindex is
2828 for J in S.all'Range loop
2829 H := H * 2 + Character'Pos (S (J));
2832 return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));