1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, 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
39 -- used as line type markers in the ALI file. This is used in
40 -- Scan_ALI to detect (or skip) invalid lines.
42 Known_ALI_Lines
: constant array (Character range 'A' .. 'Z') of Boolean :=
43 ('V' => True, -- version
44 'M' => True, -- main program
45 'A' => True, -- argument
46 'P' => True, -- program
47 'R' => True, -- restriction
48 'I' => True, -- interrupt
51 'L' => True, -- linker option
53 'E' => True, -- external
54 'D' => True, -- dependency
56 'S' => True, -- specific dispatching
57 'Y' => True, -- limited_with
58 'Z' => True, -- implicit with from instantiation
59 'C' => True, -- SCO information
60 'F' => True, -- SPARK cross-reference information
67 procedure Initialize_ALI
is
69 -- When (re)initializing ALI data structures the ALI user expects to
70 -- get a fresh set of data structures. Thus we first need to erase the
71 -- marks put in the name table by the previous set of ALI routine calls.
72 -- These two loops are empty and harmless the first time in.
74 for J
in ALIs
.First
.. ALIs
.Last
loop
75 Set_Name_Table_Info
(ALIs
.Table
(J
).Afile
, 0);
78 for J
in Units
.First
.. Units
.Last
loop
79 Set_Name_Table_Info
(Units
.Table
(J
).Uname
, 0);
82 -- Free argument table strings
84 for J
in Args
.First
.. Args
.Last
loop
85 Free
(Args
.Table
(J
));
88 -- Initialize all tables
102 -- Add dummy zero'th item in Linker_Options and Notes for sort calls
104 Linker_Options
.Increment_Last
;
105 Notes
.Increment_Last
;
107 -- Initialize global variables recording cumulative options in all
108 -- ALI files that are read for a given processing run in gnatbind.
110 Dynamic_Elaboration_Checks_Specified
:= False;
111 Float_Format_Specified
:= ' ';
112 Locking_Policy_Specified
:= ' ';
113 No_Normalize_Scalars_Specified
:= False;
114 No_Object_Specified
:= False;
115 Normalize_Scalars_Specified
:= False;
116 Partition_Elaboration_Policy_Specified
:= ' ';
117 Queuing_Policy_Specified
:= ' ';
118 Static_Elaboration_Model_Used
:= False;
119 Task_Dispatching_Policy_Specified
:= ' ';
120 Unreserve_All_Interrupts_Specified
:= False;
121 Zero_Cost_Exceptions_Specified
:= False;
133 Read_Xref
: Boolean := False;
134 Read_Lines
: String := "";
135 Ignore_Lines
: String := "X";
136 Ignore_Errors
: Boolean := False;
137 Directly_Scanned
: Boolean := False) return ALI_Id
139 P
: Text_Ptr
:= T
'First;
140 Line
: Logical_Line_Number
:= 1;
146 Ignore
: array (Character range 'A' .. 'Z') of Boolean;
147 -- Ignore (X) is set to True if lines starting with X are to
148 -- be ignored by Scan_ALI and skipped, and False if the lines
149 -- are to be read and processed.
151 Bad_ALI_Format
: exception;
152 -- Exception raised by Fatal_Error if Err is True
154 function At_Eol
return Boolean;
155 -- Test if at end of line
157 function At_End_Of_Field
return Boolean;
158 -- Test if at end of line, or if at blank or horizontal tab
160 procedure Check_At_End_Of_Field
;
161 -- Check if we are at end of field, fatal error if not
163 procedure Checkc
(C
: Character);
164 -- Check next character is C. If so bump past it, if not fatal error
166 procedure Check_Unknown_Line
;
167 -- If Ignore_Errors mode, then checks C to make sure that it is not
168 -- an unknown ALI line type characters, and if so, skips lines
169 -- until the first character of the line is one of these characters,
170 -- at which point it does a Getc to put that character in C. The
171 -- call has no effect if C is already an appropriate character.
172 -- If not in Ignore_Errors mode, a fatal error is signalled if the
173 -- line is unknown. Note that if C is an EOL on entry, the line is
174 -- skipped (it is assumed that blank lines are never significant).
175 -- If C is EOF on entry, the call has no effect (it is assumed that
176 -- the caller will properly handle this case).
178 procedure Fatal_Error
;
179 -- Generate fatal error message for badly formatted ALI file if
180 -- Err is false, or raise Bad_ALI_Format if Err is True.
182 procedure Fatal_Error_Ignore
;
183 pragma Inline
(Fatal_Error_Ignore
);
184 -- In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
186 function Getc
return Character;
187 -- Get next character, bumping P past the character obtained
189 function Get_File_Name
190 (Lower
: Boolean := False;
191 May_Be_Quoted
: Boolean := False) return File_Name_Type
;
192 -- Skip blanks, then scan out a file name (name is left in Name_Buffer
193 -- with length in Name_Len, as well as returning a File_Name_Type value.
194 -- If May_Be_Quoted is True and the first non blank character is '"',
195 -- then remove starting and ending quotes and undoubled internal quotes.
196 -- If lower is false, the case is unchanged, if Lower is True then the
197 -- result is forced to all lower case for systems where file names are
198 -- not case sensitive. This ensures that gnatbind works correctly
199 -- regardless of the case of the file name on all systems. The scan
200 -- is terminated by a end of line, space or horizontal tab. Any other
201 -- special characters are included in the returned name.
204 (Ignore_Spaces
: Boolean := False;
205 Ignore_Special
: Boolean := False;
206 May_Be_Quoted
: Boolean := False) return Name_Id
;
207 -- Skip blanks, then scan out a name (name is left in Name_Buffer with
208 -- length in Name_Len, as well as being returned in Name_Id form).
209 -- If Lower is set to True then the Name_Buffer will be converted to
210 -- all lower case, for systems where file names are not case sensitive.
211 -- This ensures that gnatbind works correctly regardless of the case
212 -- of the file name on all systems. The termination condition depends
213 -- on the settings of Ignore_Spaces and Ignore_Special:
215 -- If Ignore_Spaces is False (normal case), then scan is terminated
216 -- by the normal end of field condition (EOL, space, horizontal tab)
218 -- If Ignore_Special is False (normal case), the scan is terminated by
219 -- a typeref bracket or an equal sign except for the special case of
220 -- an operator name starting with a double quote which is terminated
221 -- by another double quote.
223 -- If May_Be_Quoted is True and the first non blank character is '"'
224 -- the name is 'unquoted'. In this case Ignore_Special is ignored and
225 -- assumed to be True.
227 -- It is an error to set both Ignore_Spaces and Ignore_Special to True.
228 -- This function handles wide characters properly.
230 function Get_Nat
return Nat
;
231 -- Skip blanks, then scan out an unsigned integer value in Nat range
232 -- raises ALI_Reading_Error if the encoutered type is not natural.
234 function Get_Stamp
return Time_Stamp_Type
;
235 -- Skip blanks, then scan out a time stamp
237 function Get_Unit_Name
return Unit_Name_Type
;
238 -- Skip blanks, then scan out a file name (name is left in Name_Buffer
239 -- with length in Name_Len, as well as returning a Unit_Name_Type value.
240 -- The case is unchanged and terminated by a normal end of field.
242 function Nextc
return Character;
243 -- Return current character without modifying pointer P
245 procedure Get_Typeref
246 (Current_File_Num
: Sdep_Id
;
248 File_Num
: out Sdep_Id
;
250 Ref_Type
: out Character;
252 Standard_Entity
: out Name_Id
);
253 -- Parse the definition of a typeref (<...>, {...} or (...))
256 -- Skip past spaces, then skip past end of line (fatal error if not
257 -- at end of line). Also skips past any following blank lines.
260 -- Skip rest of current line and any following blank lines
262 procedure Skip_Space
;
263 -- Skip past white space (blanks or horizontal tab)
266 -- Skip past next character, does not affect value in C. This call
267 -- is like calling Getc and ignoring the returned result.
269 ---------------------
270 -- At_End_Of_Field --
271 ---------------------
273 function At_End_Of_Field
return Boolean is
282 function At_Eol
return Boolean is
284 return Nextc
= EOF
or else Nextc
= CR
or else Nextc
= LF
;
287 ---------------------------
288 -- Check_At_End_Of_Field --
289 ---------------------------
291 procedure Check_At_End_Of_Field
is
293 if not At_End_Of_Field
then
294 if Ignore_Errors
then
295 while Nextc
> ' ' loop
302 end Check_At_End_Of_Field
;
304 ------------------------
305 -- Check_Unknown_Line --
306 ------------------------
308 procedure Check_Unknown_Line
is
310 while C
not in 'A' .. 'Z'
311 or else not Known_ALI_Lines
(C
)
313 if C
= CR
or else C
= LF
then
320 elsif Ignore_Errors
then
328 end Check_Unknown_Line
;
334 procedure Checkc
(C
: Character) is
338 elsif Ignore_Errors
then
349 procedure Fatal_Error
is
354 procedure Wchar
(C
: Character);
355 -- Write a single character, replacing horizontal tab by spaces
357 procedure Wchar
(C
: Character) is
362 exit when Col
mod 8 = 0;
371 -- Start of processing for Fatal_Error
375 raise Bad_ALI_Format
;
379 Write_Str
("fatal error: file ");
381 Write_Str
(" is incorrectly formatted");
384 Write_Str
("make sure you are using consistent versions " &
386 -- Split the following line so that it can easily be transformed for
387 -- e.g. JVM/.NET back-ends where the compiler has a different name.
393 -- Find start of line
397 and then T
(Ptr1
- 1) /= CR
398 and then T
(Ptr1
- 1) /= LF
403 Write_Int
(Int
(Line
));
418 and then T
(Ptr2
) /= CR
419 and then T
(Ptr2
) /= LF
431 if T
(Ptr1
) = HT
then
443 Exit_Program
(E_Fatal
);
446 ------------------------
447 -- Fatal_Error_Ignore --
448 ------------------------
450 procedure Fatal_Error_Ignore
is
452 if not Ignore_Errors
then
455 end Fatal_Error_Ignore
;
461 function Get_File_Name
462 (Lower
: Boolean := False;
463 May_Be_Quoted
: Boolean := False) return File_Name_Type
468 F
:= Get_Name
(Ignore_Special
=> True,
469 May_Be_Quoted
=> May_Be_Quoted
);
471 -- Convert file name to all lower case if file names are not case
472 -- sensitive. This ensures that we handle names in the canonical
473 -- lower case format, regardless of the actual case.
475 if Lower
and not File_Names_Case_Sensitive
then
476 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
479 return File_Name_Type
(F
);
488 (Ignore_Spaces
: Boolean := False;
489 Ignore_Special
: Boolean := False;
490 May_Be_Quoted
: Boolean := False) return Name_Id
499 if Ignore_Errors
then
508 -- Deal with quoted characters
510 if May_Be_Quoted
and then Char
= '"' then
513 if Ignore_Errors
then
536 Add_Char_To_Name_Buffer
(Char
);
539 -- Other than case of quoted character
544 Add_Char_To_Name_Buffer
(Getc
);
546 exit when At_End_Of_Field
and then not Ignore_Spaces
;
548 if not Ignore_Special
then
549 if Name_Buffer
(1) = '"' then
550 exit when Name_Len
> 1
551 and then Name_Buffer
(Name_Len
) = '"';
554 -- Terminate on parens or angle brackets or equal sign
556 exit when Nextc
= '(' or else Nextc
= ')'
557 or else Nextc
= '{' or else Nextc
= '}'
558 or else Nextc
= '<' or else Nextc
= '>'
561 -- Terminate on comma
563 exit when Nextc
= ',';
565 -- Terminate if left bracket not part of wide char
566 -- sequence Note that we only recognize brackets
567 -- notation so far ???
569 exit when Nextc
= '[' and then T
(P
+ 1) /= '"';
571 -- Terminate if right bracket not part of wide char
574 exit when Nextc
= ']' and then T
(P
- 1) /= '"';
587 function Get_Unit_Name
return Unit_Name_Type
is
589 return Unit_Name_Type
(Get_Name
);
596 function Get_Nat
return Nat
is
602 -- Check if we are on a number. In the case of bad ALI files, this
605 if not (Nextc
in '0' .. '9') then
611 V
:= V
* 10 + (Character'Pos (Getc
) - Character'Pos ('0'));
613 exit when At_End_Of_Field
;
614 exit when Nextc
< '0' or else Nextc
> '9';
624 function Get_Stamp
return Time_Stamp_Type
is
632 if Ignore_Errors
then
633 return Dummy_Time_Stamp
;
639 -- Following reads old style time stamp missing first two digits
641 if Nextc
in '7' .. '9' then
646 -- Normal case of full year in time stamp
652 for J
in Start
.. T
'Last loop
663 procedure Get_Typeref
664 (Current_File_Num
: Sdep_Id
;
666 File_Num
: out Sdep_Id
;
668 Ref_Type
: out Character;
670 Standard_Entity
: out Name_Id
)
675 when '<' => Ref
:= Tref_Derived
;
676 when '(' => Ref
:= Tref_Access
;
677 when '{' => Ref
:= Tref_Type
;
678 when others => Ref
:= Tref_None
;
681 -- Case of typeref field present
683 if Ref
/= Tref_None
then
684 P
:= P
+ 1; -- skip opening bracket
686 if Nextc
in 'a' .. 'z' then
687 File_Num
:= No_Sdep_Id
;
691 Standard_Entity
:= Get_Name
(Ignore_Spaces
=> True);
696 File_Num
:= Sdep_Id
(N
+ Nat
(First_Sdep_Entry
) - 1);
700 File_Num
:= Current_File_Num
;
706 Standard_Entity
:= No_Name
;
709 -- ??? Temporary workaround for nested generics case:
710 -- 4i4 Directories{1|4I9[4|6[3|3]]}
714 Nested_Brackets
: Natural := 0;
720 Nested_Brackets
:= Nested_Brackets
+ 1;
722 Nested_Brackets
:= Nested_Brackets
- 1;
724 if Nested_Brackets
= 0 then
733 P
:= P
+ 1; -- skip closing bracket
736 -- No typeref entry present
739 File_Num
:= No_Sdep_Id
;
743 Standard_Entity
:= No_Name
;
751 function Getc
return Character is
765 function Nextc
return Character is
774 procedure Skip_Eol
is
779 if Ignore_Errors
then
780 while not At_Eol
loop
788 -- Loop to skip past blank lines (first time through skips this EOL)
790 while Nextc
< ' ' and then Nextc
/= EOF
loop
803 procedure Skip_Line
is
805 while not At_Eol
loop
816 procedure Skip_Space
is
818 while Nextc
= ' ' or else Nextc
= HT
loop
834 -- Start of processing for Scan_ALI
837 First_Sdep_Entry
:= Sdep
.Last
+ 1;
839 -- Acquire lines to be ignored
843 ('U' |
'W' |
'Y' |
'Z' |
'D' |
'X' => False, others => True);
845 -- Read_Lines parameter given
847 elsif Read_Lines
/= "" then
848 Ignore
:= ('U' => False, others => True);
850 for J
in Read_Lines
'Range loop
851 Ignore
(Read_Lines
(J
)) := False;
854 -- Process Ignore_Lines parameter
857 Ignore
:= (others => False);
859 for J
in Ignore_Lines
'Range loop
860 pragma Assert
(Ignore_Lines
(J
) /= 'U');
861 Ignore
(Ignore_Lines
(J
)) := True;
865 -- Setup ALI Table entry with appropriate defaults
869 Set_Name_Table_Info
(F
, Int
(Id
));
873 Compile_Errors
=> False,
874 First_Interrupt_State
=> Interrupt_States
.Last
+ 1,
875 First_Sdep
=> No_Sdep_Id
,
876 First_Specific_Dispatching
=> Specific_Dispatching
.Last
+ 1,
877 First_Unit
=> No_Unit_Id
,
879 Last_Interrupt_State
=> Interrupt_States
.Last
,
880 Last_Sdep
=> No_Sdep_Id
,
881 Last_Specific_Dispatching
=> Specific_Dispatching
.Last
,
882 Last_Unit
=> No_Unit_Id
,
883 Locking_Policy
=> ' ',
886 Main_Program
=> None
,
888 Normalize_Scalars
=> False,
889 Ofile_Full_Name
=> Full_Object_File_Name
,
890 Partition_Elaboration_Policy
=> ' ',
891 Queuing_Policy
=> ' ',
892 Restrictions
=> No_Restrictions
,
893 SAL_Interface
=> False,
895 Task_Dispatching_Policy
=> ' ',
896 Time_Slice_Value
=> -1,
897 Allocator_In_Body
=> False,
899 Unit_Exception_Table
=> False,
900 Ver
=> (others => ' '),
902 Zero_Cost_Exceptions
=> False);
904 -- Now we acquire the input lines from the ALI file. Note that the
905 -- convention in the following code is that as we enter each section,
906 -- C is set to contain the first character of the following line.
911 -- Acquire library version
915 -- The V line missing really indicates trouble, most likely it
916 -- means we don't have an ALI file at all, so here we give a
917 -- fatal error even if we are in Ignore_Errors mode.
921 elsif Ignore
('V') then
929 for J
in 1 .. Ver_Len_Max
loop
932 ALIs
.Table
(Id
).Ver
(J
) := C
;
933 ALIs
.Table
(Id
).Ver_Len
:= J
;
942 -- Acquire main program line if present
955 ALIs
.Table
(Id
).Main_Program
:= Func
;
957 ALIs
.Table
(Id
).Main_Program
:= Proc
;
967 ALIs
.Table
(Id
).Main_Priority
:= Get_Nat
;
975 ALIs
.Table
(Id
).Time_Slice_Value
:= Get_Nat
;
983 ALIs
.Table
(Id
).Allocator_In_Body
:= True;
991 ALIs
.Table
(Id
).Main_CPU
:= Get_Nat
;
998 ALIs
.Table
(Id
).WC_Encoding
:= Getc
;
1007 -- Acquire argument lines
1009 First_Arg
:= Args
.Last
+ 1;
1013 exit A_Loop
when C
/= 'A';
1015 if Ignore
('A') then
1021 -- Scan out argument
1024 while not At_Eol
loop
1025 Add_Char_To_Name_Buffer
(Getc
);
1028 -- If -fstack-check, record that it occurred. Note that an
1029 -- additional string parameter can be specified, in the form of
1030 -- -fstack-check={no|generic|specific}. "no" means no checking,
1031 -- "generic" means force the use of old-style checking, and
1032 -- "specific" means use the best checking method.
1035 and then Name_Buffer
(1 .. 13) = "-fstack-check"
1036 and then Name_Buffer
(1 .. Name_Len
) /= "-fstack-check=no"
1038 Stack_Check_Switch_Set
:= True;
1041 -- Store the argument
1043 Args
.Increment_Last
;
1044 Args
.Table
(Args
.Last
) := new String'(Name_Buffer (1 .. Name_Len));
1057 if Ignore_Errors then
1069 if Ignore ('P
') then
1077 while not At_Eol loop
1082 -- Processing for CE
1086 ALIs.Table (Id).Compile_Errors := True;
1088 -- Processing for DB
1092 Detect_Blocking := True;
1094 -- Processing for Ex
1097 Partition_Elaboration_Policy_Specified := Getc;
1098 ALIs.Table (Id).Partition_Elaboration_Policy :=
1099 Partition_Elaboration_Policy_Specified;
1101 -- Processing for FD/FG/FI
1104 Float_Format_Specified := Getc;
1105 ALIs.Table (Id).Float_Format := Float_Format_Specified;
1107 -- Processing for Lx
1110 Locking_Policy_Specified := Getc;
1111 ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
1113 -- Processing for flags starting with N
1118 -- Processing for NO
1121 ALIs.Table (Id).No_Object := True;
1122 No_Object_Specified := True;
1124 -- Processing for NR
1127 No_Run_Time_Mode := True;
1128 Configurable_Run_Time_Mode := True;
1130 -- Processing for NS
1133 ALIs.Table (Id).Normalize_Scalars := True;
1134 Normalize_Scalars_Specified := True;
1137 -- Invalid switch starting with N
1143 -- Processing for Qx
1146 Queuing_Policy_Specified := Getc;
1147 ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
1149 -- Processing for flags starting with S
1154 -- Processing for SL
1157 ALIs.Table (Id).SAL_Interface := True;
1159 -- Processing for SS
1162 Opt.Sec_Stack_Used := True;
1164 -- Invalid switch starting with S
1170 -- Processing for Tx
1173 Task_Dispatching_Policy_Specified := Getc;
1174 ALIs.Table (Id).Task_Dispatching_Policy :=
1175 Task_Dispatching_Policy_Specified;
1177 -- Processing for switch starting with U
1182 -- Processing for UA
1185 Unreserve_All_Interrupts_Specified := True;
1187 -- Processing for UX
1190 ALIs.Table (Id).Unit_Exception_Table := True;
1192 -- Invalid switches starting with U
1198 -- Processing for ZX
1204 ALIs.Table (Id).Zero_Cost_Exceptions := True;
1205 Zero_Cost_Exceptions_Specified := True;
1210 -- Invalid parameter
1218 if not NS_Found then
1219 No_Normalize_Scalars_Specified := True;
1228 -- Loop to skip to first restrictions line
1231 if Ignore_Errors then
1243 -- Ignore all 'R
' lines if that is required
1245 if Ignore ('R
') then
1251 -- Here we process the restrictions lines (other than unit name cases)
1254 Scan_Restrictions : declare
1255 Save_R : constant Restrictions_Info := Cumulative_Restrictions;
1256 -- Save cumulative restrictions in case we have a fatal error
1258 Bad_R_Line : exception;
1259 -- Signal bad restrictions line (raised on unexpected character)
1266 -- Named restriction case
1272 -- Loop through RR and RV lines
1274 while C = 'R
' and then Nextc /= ' ' loop
1278 -- Acquire restriction name
1281 while not At_Eol and then Nextc /= '=' loop
1282 Name_Len := Name_Len + 1;
1283 Name_Buffer (Name_Len) := Getc;
1286 -- Now search list of restrictions to find match
1289 RN : String renames Name_Buffer (1 .. Name_Len);
1292 R := Restriction_Id'First;
1293 while R < Not_A_Restriction_Id loop
1294 if Restriction_Id'Image (R) = RN then
1298 R := Restriction_Id'Succ (R);
1301 -- We don't recognize the restriction. This might be
1302 -- thought of as an error, and it really is, but we
1303 -- want to allow building with inconsistent versions
1304 -- of the binder and ali files (see comments at the
1305 -- start of package System.Rident), so we just ignore
1308 goto Done_With_Restriction_Line;
1315 -- Boolean restriction case
1317 when All_Boolean_Restrictions =>
1320 ALIs.Table (Id).Restrictions.Violated (R) :=
1322 Cumulative_Restrictions.Violated (R) := True;
1325 ALIs.Table (Id).Restrictions.Set (R) := True;
1326 Cumulative_Restrictions.Set (R) := True;
1332 -- Parameter restriction case
1334 when All_Parameter_Restrictions =>
1335 if At_Eol or else Nextc /= '=' then
1341 N := Natural (Get_Nat);
1348 ALIs.Table (Id).Restrictions.Set (R) := True;
1349 ALIs.Table (Id).Restrictions.Value (R) := N;
1351 if Cumulative_Restrictions.Set (R) then
1352 Cumulative_Restrictions.Value (R) :=
1354 (Cumulative_Restrictions.Value (R), N);
1356 Cumulative_Restrictions.Set (R) := True;
1357 Cumulative_Restrictions.Value (R) := N;
1360 -- Restriction violated
1363 ALIs.Table (Id).Restrictions.Violated (R) :=
1365 Cumulative_Restrictions.Violated (R) := True;
1366 ALIs.Table (Id).Restrictions.Count (R) := N;
1368 -- Checked Max_Parameter case
1370 if R in Checked_Max_Parameter_Restrictions then
1371 Cumulative_Restrictions.Count (R) :=
1373 (Cumulative_Restrictions.Count (R), N);
1375 -- Other checked parameter cases
1379 pragma Unsuppress (Overflow_Check);
1382 Cumulative_Restrictions.Count (R) :=
1383 Cumulative_Restrictions.Count (R) + N;
1386 when Constraint_Error =>
1388 -- A constraint error comes from the
1389 -- addition. We reset to the maximum
1390 -- and indicate that the real value
1393 Cumulative_Restrictions.Value (R) :=
1395 Cumulative_Restrictions.Unknown (R) :=
1404 ALIs.Table (Id).Restrictions.Unknown (R) :=
1406 Cumulative_Restrictions.Unknown (R) := True;
1409 -- Other than 'R
' or 'V
'
1419 -- Bizarre error case NOT_A_RESTRICTION
1421 when Not_A_Restriction_Id =>
1429 <<Done_With_Restriction_Line>>
1434 -- Positional restriction case
1440 -- Acquire information for boolean restrictions
1442 for R in All_Boolean_Restrictions loop
1447 ALIs.Table (Id).Restrictions.Violated (R) := True;
1448 Cumulative_Restrictions.Violated (R) := True;
1451 ALIs.Table (Id).Restrictions.Set (R) := True;
1452 Cumulative_Restrictions.Set (R) := True;
1462 -- Acquire information for parameter restrictions
1464 for RP in All_Parameter_Restrictions loop
1470 ALIs.Table (Id).Restrictions.Set (RP) := True;
1473 N : constant Integer := Integer (Get_Nat);
1475 ALIs.Table (Id).Restrictions.Value (RP) := N;
1477 if Cumulative_Restrictions.Set (RP) then
1478 Cumulative_Restrictions.Value (RP) :=
1480 (Cumulative_Restrictions.Value (RP), N);
1482 Cumulative_Restrictions.Set (RP) := True;
1483 Cumulative_Restrictions.Value (RP) := N;
1491 -- Acquire restrictions violations information
1499 ALIs.Table (Id).Restrictions.Violated (RP) := True;
1500 Cumulative_Restrictions.Violated (RP) := True;
1503 N : constant Integer := Integer (Get_Nat);
1506 ALIs.Table (Id).Restrictions.Count (RP) := N;
1508 if RP in Checked_Max_Parameter_Restrictions then
1509 Cumulative_Restrictions.Count (RP) :=
1511 (Cumulative_Restrictions.Count (RP), N);
1515 pragma Unsuppress (Overflow_Check);
1518 Cumulative_Restrictions.Count (RP) :=
1519 Cumulative_Restrictions.Count (RP) + N;
1522 when Constraint_Error =>
1524 -- A constraint error comes from the add. We
1525 -- reset to the maximum and indicate that the
1526 -- real value is now unknown.
1528 Cumulative_Restrictions.Value (RP) :=
1530 Cumulative_Restrictions.Unknown (RP) := True;
1536 ALIs.Table (Id).Restrictions.Unknown (RP) := True;
1537 Cumulative_Restrictions.Unknown (RP) := True;
1554 -- Here if error during scanning of restrictions line
1559 -- In Ignore_Errors mode, undo any changes to restrictions
1560 -- from this unit, and continue on, skipping remaining R
1561 -- lines for this unit.
1563 if Ignore_Errors then
1564 Cumulative_Restrictions := Save_R;
1565 ALIs.Table (Id).Restrictions := No_Restrictions;
1573 -- In normal mode, this is a fatal error
1578 end Scan_Restrictions;
1581 -- Acquire additional restrictions (No_Dependence) lines if present
1584 if Ignore ('R
') then
1588 No_Deps.Append ((Id, Get_Name));
1595 -- Acquire 'I
' lines if present
1600 if Ignore ('I
') then
1606 I_State : Character;
1615 Interrupt_States.Append (
1616 (Interrupt_Id => Int_Num,
1617 Interrupt_State => I_State,
1618 IS_Pragma_Line => Line_No));
1620 ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
1628 -- Acquire 'S
' lines if present
1633 if Ignore ('S
') then
1649 First_Prio := Get_Nat;
1650 Last_Prio := Get_Nat;
1653 Specific_Dispatching.Append (
1654 (Dispatching_Policy => Policy,
1655 First_Priority => First_Prio,
1656 Last_Priority => Last_Prio,
1657 PSD_Pragma_Line => Line_No));
1659 ALIs.Table (Id).Last_Specific_Dispatching :=
1660 Specific_Dispatching.Last;
1669 -- Loop to acquire unit entries
1673 exit U_Loop when C /= 'U
';
1675 -- Note: as per spec, we never ignore U lines
1679 Units.Increment_Last;
1681 if ALIs.Table (Id).First_Unit = No_Unit_Id then
1682 ALIs.Table (Id).First_Unit := Units.Last;
1686 UL : Unit_Record renames Units.Table (Units.Last);
1689 UL.Uname := Get_Unit_Name;
1690 UL.Predefined := Is_Predefined_Unit;
1691 UL.Internal := Is_Internal_Unit;
1693 UL.Sfile := Get_File_Name (Lower => True);
1695 UL.Preelab := False;
1696 UL.No_Elab := False;
1697 UL.Shared_Passive := False;
1699 UL.Remote_Types := False;
1700 UL.Has_RACW := False;
1701 UL.Init_Scalars := False;
1702 UL.Is_Generic := False;
1703 UL.Icasing := Mixed_Case;
1704 UL.Kcasing := All_Lower_Case;
1705 UL.Dynamic_Elab := False;
1706 UL.Elaborate_Body := False;
1707 UL.Set_Elab_Entity := False;
1708 UL.Version := "00000000";
1709 UL.First_With := Withs.Last + 1;
1710 UL.First_Arg := First_Arg;
1711 UL.Elab_Position := 0;
1712 UL.SAL_Interface := ALIs.Table (Id).SAL_Interface;
1713 UL.Directly_Scanned := Directly_Scanned;
1714 UL.Body_Needed_For_SAL := False;
1715 UL.Elaborate_Body_Desirable := False;
1716 UL.Optimize_Alignment := 'O
';
1717 UL.Has_Finalizer := False;
1719 if Debug_Flag_U then
1720 Write_Str (" ----> reading unit ");
1721 Write_Int (Int (Units.Last));
1723 Write_Unit_Name (UL.Uname);
1724 Write_Str (" from file ");
1725 Write_Name (UL.Sfile);
1730 -- Check for duplicated unit in different files
1733 Info : constant Int := Get_Name_Table_Info
1734 (Units.Table (Units.Last).Uname);
1737 and then Units.Table (Units.Last).Sfile /=
1738 Units.Table (Unit_Id (Info)).Sfile
1740 -- If Err is set then ignore duplicate unit name. This is the
1741 -- case of a call from gnatmake, where the situation can arise
1742 -- from substitution of source files. In such situations, the
1743 -- processing in gnatmake will always result in any required
1744 -- recompilations in any case, and if we consider this to be
1745 -- an error we get strange cases (for example when a generic
1746 -- instantiation is replaced by a normal package) where we
1747 -- read the old ali file, decide to recompile, and then decide
1748 -- that the old and new ali files are incompatible.
1753 -- If Err is not set, then this is a fatal error. This is
1754 -- the case of being called from the binder, where we must
1755 -- definitely diagnose this as an error.
1759 Write_Str ("error: duplicate unit name: ");
1762 Write_Str ("error: unit """);
1763 Write_Unit_Name (Units.Table (Units.Last).Uname);
1764 Write_Str (""" found in file """);
1765 Write_Name_Decoded (Units.Table (Units.Last).Sfile);
1769 Write_Str ("error
: unit
""");
1770 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1771 Write_Str (""" found
in file
""");
1772 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1776 Exit_Program (E_Fatal);
1782 (Units.Table (Units.Last).Uname, Int (Units.Last));
1784 -- Scan out possible version and other parameters
1793 if C in '0' .. '9' or else C in 'a
' .. 'f
' then
1794 Units.Table (Units.Last).Version (1) := C;
1796 for J in 2 .. 8 loop
1798 Units.Table (Units.Last).Version (J) := C;
1807 Check_At_End_Of_Field;
1808 Units.Table (Units.Last).Elaborate_Body_Desirable := True;
1811 Check_At_End_Of_Field;
1812 Units.Table (Units.Last).Body_Needed_For_SAL := True;
1818 -- DE parameter (Dynamic elaboration checks)
1824 Check_At_End_Of_Field;
1825 Units.Table (Units.Last).Dynamic_Elab := True;
1826 Dynamic_Elaboration_Checks_Specified := True;
1837 Units.Table (Units.Last).Elaborate_Body := True;
1839 Units.Table (Units.Last).Set_Elab_Entity := True;
1844 Check_At_End_Of_Field;
1846 -- GE parameter (generic)
1852 Check_At_End_Of_Field;
1853 Units.Table (Units.Last).Is_Generic := True;
1858 -- IL/IS/IU parameters
1864 Units.Table (Units.Last).Icasing := All_Lower_Case;
1866 Units.Table (Units.Last).Init_Scalars := True;
1867 Initialize_Scalars_Used := True;
1869 Units.Table (Units.Last).Icasing := All_Upper_Case;
1874 Check_At_End_Of_Field;
1882 Units.Table (Units.Last).Kcasing := Mixed_Case;
1884 Units.Table (Units.Last).Kcasing := All_Upper_Case;
1889 Check_At_End_Of_Field;
1897 Units.Table (Units.Last).No_Elab := True;
1898 Check_At_End_Of_Field;
1903 -- PF/PR/PU/PK parameters
1909 Units.Table (Units.Last).Has_Finalizer := True;
1911 Units.Table (Units.Last).Preelab := True;
1913 Units.Table (Units.Last).Pure := True;
1915 Units.Table (Units.Last).Unit_Kind := 'p
';
1920 Check_At_End_Of_Field;
1922 -- OL/OO/OS/OT parameters
1927 if C = 'L
' or else C = 'O
' or else C = 'S
' or else C = 'T
' then
1928 Units.Table (Units.Last).Optimize_Alignment := C;
1933 Check_At_End_Of_Field;
1941 Units.Table (Units.Last).RCI := True;
1943 Units.Table (Units.Last).Remote_Types := True;
1945 Units.Table (Units.Last).Has_RACW := True;
1950 Check_At_End_Of_Field;
1956 Units.Table (Units.Last).Shared_Passive := True;
1958 Units.Table (Units.Last).Unit_Kind := 's
';
1963 Check_At_End_Of_Field;
1973 -- Check if static elaboration model used
1975 if not Units.Table (Units.Last).Dynamic_Elab
1976 and then not Units.Table (Units.Last).Internal
1978 Static_Elaboration_Model_Used := True;
1983 -- Scan out With lines for this unit
1987 exit With_Loop when C /= 'W
' and then C /= 'Y
' and then C /= 'Z
';
1989 if Ignore ('W
') then
1995 Withs.Increment_Last;
1996 Withs.Table (Withs.Last).Uname := Get_Unit_Name;
1997 Withs.Table (Withs.Last).Elaborate := False;
1998 Withs.Table (Withs.Last).Elaborate_All := False;
1999 Withs.Table (Withs.Last).Elab_Desirable := False;
2000 Withs.Table (Withs.Last).Elab_All_Desirable := False;
2001 Withs.Table (Withs.Last).SAL_Interface := False;
2002 Withs.Table (Withs.Last).Limited_With := (C = 'Y
');
2003 Withs.Table (Withs.Last).Implicit_With_From_Instantiation
2006 -- Generic case with no object file available
2009 Withs.Table (Withs.Last).Sfile := No_File;
2010 Withs.Table (Withs.Last).Afile := No_File;
2015 Withs.Table (Withs.Last).Sfile := Get_File_Name
2017 Withs.Table (Withs.Last).Afile := Get_File_Name
2020 -- Scan out possible E, EA, ED, and AD parameters
2022 while not At_Eol loop
2028 Check_At_End_Of_Field;
2030 -- Store AD indication unless ignore required
2032 if not Ignore_ED then
2033 Withs.Table (Withs.Last).Elab_All_Desirable :=
2037 elsif Nextc = 'E
' then
2040 if At_End_Of_Field then
2041 Withs.Table (Withs.Last).Elaborate := True;
2043 elsif Nextc = 'A
' then
2045 Check_At_End_Of_Field;
2046 Withs.Table (Withs.Last).Elaborate_All := True;
2050 Check_At_End_Of_Field;
2052 -- Store ED indication unless ignore required
2054 if not Ignore_ED then
2055 Withs.Table (Withs.Last).Elab_Desirable :=
2072 Units.Table (Units.Last).Last_With := Withs.Last;
2073 Units.Table (Units.Last).Last_Arg := Args.Last;
2075 -- If there are linker options lines present, scan them
2079 Linker_Options_Loop : loop
2081 exit Linker_Options_Loop when C /= 'L
';
2083 if Ignore ('L
') then
2094 if C < Character'Val (16#20#)
2095 or else C > Character'Val (16#7E#)
2100 C := Character'Val (0);
2107 for J in 1 .. 2 loop
2110 if C in '0' .. '9' then
2113 Character'Pos ('0');
2115 elsif C in 'A' .. 'F' then
2118 Character'Pos ('A') +
2127 Add_Char_To_Name_Buffer (Character'Val (V));
2132 exit when Nextc /= '"';
2136 Add_Char_To_Name_Buffer (C);
2140 Add_Char_To_Name_Buffer (NUL);
2145 end loop Linker_Options_Loop;
2147 -- Store the linker options entry if one was found
2149 if Name_Len /= 0 then
2150 Linker_Options.Increment_Last;
2152 Linker_Options.Table (Linker_Options.Last).Name :=
2155 Linker_Options.Table (Linker_Options.Last).Unit :=
2158 Linker_Options.Table (Linker_Options.Last).Internal_File :=
2159 Is_Internal_File_Name (F);
2161 Linker_Options.Table (Linker_Options.Last).Original_Pos :=
2162 Linker_Options.Last;
2165 -- If there are notes present, scan them
2169 exit Notes_Loop when C /= 'N';
2171 if Ignore ('N') then
2177 Notes.Increment_Last;
2178 Notes.Table (Notes.Last).Pragma_Type := Getc;
2179 Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
2181 Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
2182 Notes.Table (Notes.Last).Unit := Units.Last;
2185 Notes.Table (Notes.Last).Pragma_Args := No_Name;
2191 while not At_Eol loop
2192 Add_Char_To_Name_Buffer (Getc);
2195 Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
2202 end loop Notes_Loop;
2205 -- End loop through units for one ALI file
2207 ALIs.Table (Id).Last_Unit := Units.Last;
2208 ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
2210 -- Set types of the units (there can be at most 2 of them)
2212 if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
2213 Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
2214 Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
2217 -- Deal with body only and spec only cases, note that the reason we
2218 -- do our own checking of the name (rather than using Is_Body_Name)
2219 -- is that Uname drags in far too much compiler junk!
2221 Get_Name_String (Units.Table (Units.Last).Uname);
2223 if Name_Buffer (Name_Len) = 'b' then
2224 Units.Table (Units.Last).Utype := Is_Body_Only;
2226 Units.Table (Units.Last).Utype := Is_Spec_Only;
2230 -- Scan out external version references and put in hash table
2234 exit E_Loop when C /= 'E';
2236 if Ignore ('E') then
2252 exit when At_End_Of_Field;
2253 Add_Char_To_Name_Buffer (C);
2256 Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
2263 -- Scan out source dependency lines for this ALI file
2265 ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
2269 exit D_Loop when C /= 'D';
2271 if Ignore ('D') then
2277 Sdep.Increment_Last;
2279 -- In the following call, Lower is not set to True, this is either
2280 -- a bug, or it deserves a special comment as to why this is so???
2282 -- The file/path name may be quoted
2284 Sdep.Table (Sdep.Last).Sfile :=
2285 Get_File_Name (May_Be_Quoted => True);
2287 Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
2288 Sdep.Table (Sdep.Last).Dummy_Entry :=
2289 (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
2291 -- Acquire checksum value
2304 exit when At_Eol or else Ctr = 8;
2306 if Nextc in '0' .. '9' then
2308 Character'Pos (Nextc) - Character'Pos ('0');
2310 elsif Nextc in 'a' .. 'f' then
2312 Character'Pos (Nextc) - Character'Pos ('a') + 10;
2322 if Ctr = 8 and then At_End_Of_Field then
2323 Sdep.Table (Sdep.Last).Checksum := Chk;
2329 -- Acquire subunit and reference file name entries
2331 Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
2332 Sdep.Table (Sdep.Last).Rfile :=
2333 Sdep.Table (Sdep.Last).Sfile;
2334 Sdep.Table (Sdep.Last).Start_Line := 1;
2339 -- Here for subunit name
2341 if Nextc not in '0' .. '9' then
2343 while not At_End_Of_Field loop
2344 Add_Char_To_Name_Buffer (Getc);
2347 -- Set the subunit name. Note that we use Name_Find rather
2348 -- than Name_Enter here as the subunit name may already
2349 -- have been put in the name table by the Project Manager.
2351 Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
2356 -- Here for reference file name entry
2358 if Nextc in '0' .. '9' then
2359 Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
2364 while not At_End_Of_Field loop
2365 Add_Char_To_Name_Buffer (Getc);
2368 Sdep.Table (Sdep.Last).Rfile := Name_Enter;
2378 ALIs.Table (Id).Last_Sdep := Sdep.Last;
2380 -- We must at this stage be at an Xref line or the end of file
2392 -- If we are ignoring Xref sections we are done (we ignore all
2393 -- remaining lines since only xref related lines follow X).
2395 if Ignore ('X') and then not Debug_Flag_X then
2399 -- Loop through Xref sections
2403 exit X_Loop when C /= 'X';
2405 -- Make new entry in section table
2407 Xref_Section.Increment_Last;
2409 Read_Refs_For_One_File : declare
2410 XS : Xref_Section_Record renames
2411 Xref_Section.Table (Xref_Section.Last);
2413 Current_File_Num : Sdep_Id;
2414 -- Keeps track of the current file number (changed by nn|)
2417 XS.File_Num := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
2418 XS.File_Name := Get_File_Name;
2419 XS.First_Entity := Xref_Entity.Last + 1;
2421 Current_File_Num := XS.File_Num;
2428 -- Loop through Xref entities
2430 while C /= 'X' and then C /= EOF loop
2431 Xref_Entity.Increment_Last;
2433 Read_Refs_For_One_Entity : declare
2434 XE : Xref_Entity_Record renames
2435 Xref_Entity.Table (Xref_Entity.Last);
2438 procedure Read_Instantiation_Reference;
2439 -- Acquire instantiation reference. Caller has checked
2440 -- that current character is '[' and on return the cursor
2441 -- is skipped past the corresponding closing ']'.
2443 ----------------------------------
2444 -- Read_Instantiation_Reference --
2445 ----------------------------------
2447 procedure Read_Instantiation_Reference is
2448 Local_File_Num : Sdep_Id := Current_File_Num;
2451 Xref.Increment_Last;
2454 XR : Xref_Record renames Xref.Table (Xref.Last);
2457 P := P + 1; -- skip [
2462 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2463 Local_File_Num := XR.File_Num;
2468 XR.File_Num := Local_File_Num;
2475 -- Recursive call for next reference
2478 pragma Warnings (Off); -- kill recursion warning
2479 Read_Instantiation_Reference;
2480 pragma Warnings (On);
2483 -- Skip closing bracket after recursive call
2487 end Read_Instantiation_Reference;
2489 -- Start of processing for Read_Refs_For_One_Entity
2498 XE.Visibility := Global;
2500 XE.Visibility := Static;
2502 XE.Visibility := Other;
2505 XE.Entity := Get_Name;
2507 -- Handle the information about generic instantiations
2510 Skipc; -- Opening '['
2513 if Nextc /= '|' then
2514 XE.Iref_File_Num := Current_File_Num;
2518 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2520 XE.Iref_Line := Get_Nat;
2528 XE.Iref_File_Num := No_Sdep_Id;
2532 Current_File_Num := XS.File_Num;
2534 -- Renaming reference is present
2538 XE.Rref_Line := Get_Nat;
2544 XE.Rref_Col := Get_Nat;
2546 -- No renaming reference present
2555 XE.Oref_File_Num := No_Sdep_Id;
2556 XE.Tref_File_Num := No_Sdep_Id;
2557 XE.Tref := Tref_None;
2558 XE.First_Xref := Xref.Last + 1;
2560 -- Loop to check for additional info present
2573 (Current_File_Num, Ref, File, Line, Typ, Col, Std);
2574 exit when Ref = Tref_None;
2576 -- Do we have an overriding procedure?
2578 if Ref = Tref_Derived and then Typ = 'p' then
2579 XE.Oref_File_Num := File;
2580 XE.Oref_Line := Line;
2583 -- Arrays never override anything, and <> points to
2584 -- the index types instead
2586 elsif Ref = Tref_Derived and then XE.Etype = 'A' then
2588 -- Index types are stored in the list of references
2590 Xref.Increment_Last;
2593 XR : Xref_Record renames Xref.Table (Xref.Last);
2595 XR.File_Num := File;
2597 XR.Rtype := Array_Index_Reference;
2602 -- Interfaces are stored in the list of references,
2603 -- although the parent type itself is stored in XE.
2604 -- The first interface (when there are only
2605 -- interfaces) is stored in XE.Tref*)
2607 elsif Ref = Tref_Derived
2609 and then XE.Tref_File_Num /= No_Sdep_Id
2611 Xref.Increment_Last;
2614 XR : Xref_Record renames Xref.Table (Xref.Last);
2616 XR.File_Num := File;
2618 XR.Rtype := Interface_Reference;
2625 XE.Tref_File_Num := File;
2626 XE.Tref_Line := Line;
2627 XE.Tref_Type := Typ;
2629 XE.Tref_Standard_Entity := Std;
2634 -- Loop through cross-references for this entity
2641 exit when Nextc /= '.';
2645 Xref.Increment_Last;
2648 XR : Xref_Record renames Xref.Table (Xref.Last);
2655 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
2656 Current_File_Num := XR.File_Num;
2660 XR.File_Num := Current_File_Num;
2666 -- Imported entities reference as in:
2667 -- 494b<c,__gnat_copy_attribs>25
2671 XR.Imported_Lang := Get_Name;
2673 pragma Assert (Nextc = ',');
2676 XR.Imported_Name := Get_Name;
2678 pragma Assert (Nextc = '>');
2682 XR.Imported_Lang := No_Name;
2683 XR.Imported_Name := No_Name;
2689 Read_Instantiation_Reference;
2694 -- Record last cross-reference
2696 XE.Last_Xref := Xref.Last;
2700 when Bad_ALI_Format =>
2702 -- If ignoring errors, then we skip a line with an
2703 -- unexpected error, and try to continue subsequent
2706 if Ignore_Errors then
2707 Xref_Entity.Decrement_Last;
2711 -- Otherwise, we reraise the fatal exception
2716 end Read_Refs_For_One_Entity;
2719 -- Record last entity
2721 XS.Last_Entity := Xref_Entity.Last;
2723 end Read_Refs_For_One_File;
2728 -- Here after dealing with xref sections
2730 -- Ignore remaining lines, which belong to an additional section of the
2731 -- ALI file not considered here (like SCO or SPARK information).
2738 when Bad_ALI_Format =>
2746 function SEq (F1, F2 : String_Ptr) return Boolean is
2748 return F1.all = F2.all;
2755 function SHash (S : String_Ptr) return Vindex is
2760 for J in S.all'Range loop
2761 H := H * 2 + Character'Pos (S (J));
2764 return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));