1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Butil
; use Butil
;
28 with Debug
; use Debug
;
29 with Fname
; use Fname
;
30 with Namet
; use Namet
;
32 with Osint
; use Osint
;
33 with Output
; use Output
;
38 -- Make control characters visible
40 -- The following variable records which characters currently are
41 -- used as line type markers in the ALI file. This is used in
42 -- Scan_ALI to detect (or skip) invalid lines.
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
54 'E' => True, -- external
55 'D' => True, -- dependency
63 procedure Initialize_ALI
is
65 -- When (re)initializing ALI data structures the ALI user expects to
66 -- get a fresh set of data structures. Thus we first need to erase the
67 -- marks put in the name table by the previous set of ALI routine calls.
68 -- These two loops are empty and harmless the first time in.
70 for J
in ALIs
.First
.. ALIs
.Last
loop
71 Set_Name_Table_Info
(ALIs
.Table
(J
).Afile
, 0);
74 for J
in Units
.First
.. Units
.Last
loop
75 Set_Name_Table_Info
(Units
.Table
(J
).Uname
, 0);
78 -- Free argument table strings
80 for J
in Args
.First
.. Args
.Last
loop
81 Free
(Args
.Table
(J
));
84 -- Initialize all tables
96 -- Add dummy zero'th item in Linker_Options for the sort function
98 Linker_Options
.Increment_Last
;
100 -- Initialize global variables recording cumulative options in all
101 -- ALI files that are read for a given processing run in gnatbind.
103 Dynamic_Elaboration_Checks_Specified
:= False;
104 Float_Format_Specified
:= ' ';
105 Locking_Policy_Specified
:= ' ';
106 No_Normalize_Scalars_Specified
:= False;
107 No_Object_Specified
:= False;
108 Normalize_Scalars_Specified
:= False;
109 Queuing_Policy_Specified
:= ' ';
110 Static_Elaboration_Model_Used
:= False;
111 Task_Dispatching_Policy_Specified
:= ' ';
112 Unreserve_All_Interrupts_Specified
:= False;
113 Zero_Cost_Exceptions_Specified
:= False;
125 Read_Xref
: Boolean := False;
126 Read_Lines
: String := "";
127 Ignore_Lines
: String := "X";
128 Ignore_Errors
: Boolean := False) return ALI_Id
130 P
: Text_Ptr
:= T
'First;
131 Line
: Logical_Line_Number
:= 1;
137 Ignore
: array (Character range 'A' .. 'Z') of Boolean;
138 -- Ignore (X) is set to True if lines starting with X are to
139 -- be ignored by Scan_ALI and skipped, and False if the lines
140 -- are to be read and processed.
142 Restrictions_Initial
: Rident
.Restrictions_Info
;
143 pragma Warnings
(Off
, Restrictions_Initial
);
144 -- This variable, which should really be a constant (but that's not
145 -- allowed by the language) is used only for initialization, and the
146 -- reason we are declaring it is to get the default initialization
147 -- set for the object.
149 Bad_ALI_Format
: exception;
150 -- Exception raised by Fatal_Error if Err is True
152 function At_Eol
return Boolean;
153 -- Test if at end of line
155 function At_End_Of_Field
return Boolean;
156 -- Test if at end of line, or if at blank or horizontal tab
158 procedure Check_At_End_Of_Field
;
159 -- Check if we are at end of field, fatal error if not
161 procedure Checkc
(C
: Character);
162 -- Check next character is C. If so bump past it, if not fatal error
164 procedure Check_Unknown_Line
;
165 -- If Ignore_Errors mode, then checks C to make sure that it is not
166 -- an unknown ALI line type characters, and if so, skips lines
167 -- until the first character of the line is one of these characters,
168 -- at which point it does a Getc to put that character in C. The
169 -- call has no effect if C is already an appropriate character.
170 -- If not in Ignore_Errors mode, a fatal error is signalled if the
171 -- line is unknown. Note that if C is an EOL on entry, the line is
172 -- skipped (it is assumed that blank lines are never significant).
173 -- If C is EOF on entry, the call has no effect (it is assumed that
174 -- the caller will properly handle this case).
176 procedure Fatal_Error
;
177 -- Generate fatal error message for badly formatted ALI file if
178 -- Err is false, or raise Bad_ALI_Format if Err is True.
180 procedure Fatal_Error_Ignore
;
181 pragma Inline
(Fatal_Error_Ignore
);
182 -- In Ignore_Errors mode, has no effect, otherwise same as Fatal_Error
184 function Getc
return Character;
185 -- Get next character, bumping P past the character obtained
188 (Lower
: Boolean := False;
189 Ignore_Spaces
: Boolean := False) return Name_Id
;
190 -- Skip blanks, then scan out a name (name is left in Name_Buffer with
191 -- length in Name_Len, as well as being returned in Name_Id form).
192 -- If Lower is set to True then the Name_Buffer will be converted to
193 -- all lower case, for systems where file names are not case sensitive.
194 -- This ensures that gnatbind works correctly regardless of the case
195 -- of the file name on all systems. The name is terminated by a either
196 -- white space (when Ignore_Spaces is False) or a typeref bracket or
197 -- an equal sign except for the special case of an operator name
198 -- starting with a double quite which is terminated by another double
201 function Get_Nat
return Nat
;
202 -- Skip blanks, then scan out an unsigned integer value in Nat range.
204 function Get_Stamp
return Time_Stamp_Type
;
205 -- Skip blanks, then scan out a time stamp
207 function Nextc
return Character;
208 -- Return current character without modifying pointer P
211 -- Skip past spaces, then skip past end of line (fatal error if not
212 -- at end of line). Also skips past any following blank lines.
215 -- Skip rest of current line and any following blank lines.
217 procedure Skip_Space
;
218 -- Skip past white space (blanks or horizontal tab)
221 -- Skip past next character, does not affect value in C. This call
222 -- is like calling Getc and ignoring the returned result.
224 ---------------------
225 -- At_End_Of_Field --
226 ---------------------
228 function At_End_Of_Field
return Boolean is
237 function At_Eol
return Boolean is
239 return Nextc
= EOF
or else Nextc
= CR
or else Nextc
= LF
;
242 ---------------------------
243 -- Check_At_End_Of_Field --
244 ---------------------------
246 procedure Check_At_End_Of_Field
is
248 if not At_End_Of_Field
then
249 if Ignore_Errors
then
250 while Nextc
> ' ' loop
257 end Check_At_End_Of_Field
;
263 procedure Checkc
(C
: Character) is
267 elsif Ignore_Errors
then
274 ------------------------
275 -- Check_Unknown_Line --
276 ------------------------
278 procedure Check_Unknown_Line
is
280 while C
not in 'A' .. 'Z'
281 or else not Known_ALI_Lines
(C
)
283 if C
= CR
or else C
= LF
then
290 elsif Ignore_Errors
then
298 end Check_Unknown_Line
;
304 procedure Fatal_Error
is
309 procedure Wchar
(C
: Character);
310 -- Write a single character, replacing horizontal tab by spaces
312 procedure Wchar
(C
: Character) is
317 exit when Col
mod 8 = 0;
326 -- Start of processing for Fatal_Error
330 raise Bad_ALI_Format
;
334 Write_Str
("fatal error: file ");
336 Write_Str
(" is incorrectly formatted");
339 ("make sure you are using consistent versions of gcc/gnatbind");
342 -- Find start of line
347 and then T
(Ptr1
- 1) /= CR
348 and then T
(Ptr1
- 1) /= LF
353 Write_Int
(Int
(Line
));
368 and then T
(Ptr2
) /= CR
369 and then T
(Ptr2
) /= LF
381 if T
(Ptr1
) = HT
then
393 Exit_Program
(E_Fatal
);
396 ------------------------
397 -- Fatal_Error_Ignore --
398 ------------------------
400 procedure Fatal_Error_Ignore
is
402 if not Ignore_Errors
then
405 end Fatal_Error_Ignore
;
412 (Lower
: Boolean := False;
413 Ignore_Spaces
: Boolean := False) return Name_Id
420 if Ignore_Errors
then
428 Name_Len
:= Name_Len
+ 1;
429 Name_Buffer
(Name_Len
) := Getc
;
431 exit when At_End_Of_Field
and not Ignore_Spaces
;
433 if Name_Buffer
(1) = '"' then
434 exit when Name_Len
> 1 and then Name_Buffer
(Name_Len
) = '"';
437 exit when (At_End_Of_Field
and not Ignore_Spaces
)
438 or else Nextc
= '(' or else Nextc
= ')'
439 or else Nextc
= '{' or else Nextc
= '}'
440 or else Nextc
= '<' or else Nextc
= '>'
445 -- Convert file name to all lower case if file names are not case
446 -- sensitive. This ensures that we handle names in the canonical
447 -- lower case format, regardless of the actual case.
449 if Lower
and not File_Names_Case_Sensitive
then
450 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
460 function Get_Nat
return Nat
is
468 V
:= V
* 10 + (Character'Pos (Getc
) - Character'Pos ('0'));
469 exit when At_End_Of_Field
;
470 exit when Nextc
< '0' or Nextc
> '9';
480 function Get_Stamp
return Time_Stamp_Type
is
488 if Ignore_Errors
then
489 return Dummy_Time_Stamp
;
495 -- Following reads old style time stamp missing first two digits
497 if Nextc
in '7' .. '9' then
502 -- Normal case of full year in time stamp
508 for J
in Start
.. T
'Last loop
519 function Getc
return Character is
533 function Nextc
return Character is
542 procedure Skip_Eol
is
547 if Ignore_Errors
then
548 while not At_Eol
loop
556 -- Loop to skip past blank lines (first time through skips this EOL)
558 while Nextc
< ' ' and then Nextc
/= EOF
loop
571 procedure Skip_Line
is
573 while not At_Eol
loop
584 procedure Skip_Space
is
586 while Nextc
= ' ' or else Nextc
= HT
loop
602 -- Start of processing for Scan_ALI
605 First_Sdep_Entry
:= Sdep
.Last
+ 1;
607 -- Acquire lines to be ignored
610 Ignore
:= ('U' |
'W' |
'D' |
'X' => False, others => True);
612 -- Read_Lines parameter given
614 elsif Read_Lines
/= "" then
615 Ignore
:= ('U' => False, others => True);
617 for J
in Read_Lines
'Range loop
618 Ignore
(Read_Lines
(J
)) := False;
621 -- Process Ignore_Lines parameter
624 Ignore
:= (others => False);
626 for J
in Ignore_Lines
'Range loop
627 pragma Assert
(Ignore_Lines
(J
) /= 'U');
628 Ignore
(Ignore_Lines
(J
)) := True;
632 -- Setup ALI Table entry with appropriate defaults
636 Set_Name_Table_Info
(F
, Int
(Id
));
640 Compile_Errors
=> False,
641 First_Interrupt_State
=> Interrupt_States
.Last
+ 1,
642 First_Sdep
=> No_Sdep_Id
,
643 First_Unit
=> No_Unit_Id
,
645 Last_Interrupt_State
=> Interrupt_States
.Last
,
646 Last_Sdep
=> No_Sdep_Id
,
647 Last_Unit
=> No_Unit_Id
,
648 Locking_Policy
=> ' ',
650 Main_Program
=> None
,
652 Normalize_Scalars
=> False,
653 Ofile_Full_Name
=> Full_Object_File_Name
,
654 Queuing_Policy
=> ' ',
655 Restrictions
=> Restrictions_Initial
,
657 Task_Dispatching_Policy
=> ' ',
658 Time_Slice_Value
=> -1,
660 Unit_Exception_Table
=> False,
661 Ver
=> (others => ' '),
664 Zero_Cost_Exceptions
=> False);
666 -- Now we acquire the input lines from the ALI file. Note that the
667 -- convention in the following code is that as we enter each section,
668 -- C is set to contain the first character of the following line.
673 -- Acquire library version
677 -- The V line missing really indicates trouble, most likely it
678 -- means we don't have an ALI file at all, so here we give a
679 -- fatal error even if we are in Ignore_Errors mode.
683 elsif Ignore
('V') then
691 for J
in 1 .. Ver_Len_Max
loop
694 ALIs
.Table
(Id
).Ver
(J
) := C
;
695 ALIs
.Table
(Id
).Ver_Len
:= J
;
704 -- Acquire main program line if present
717 ALIs
.Table
(Id
).Main_Program
:= Func
;
719 ALIs
.Table
(Id
).Main_Program
:= Proc
;
729 ALIs
.Table
(Id
).Main_Priority
:= Get_Nat
;
737 ALIs
.Table
(Id
).Time_Slice_Value
:= Get_Nat
;
744 ALIs
.Table
(Id
).WC_Encoding
:= Getc
;
753 -- Acquire argument lines
755 First_Arg
:= Args
.Last
+ 1;
759 exit A_Loop
when C
/= 'A';
768 while not At_Eol
loop
769 Name_Len
:= Name_Len
+ 1;
770 Name_Buffer
(Name_Len
) := Getc
;
774 Args
.Table
(Args
.Last
) := new String'(Name_Buffer (1 .. Name_Len));
787 if Ignore_Errors then
807 while not At_Eol loop
816 ALIs.Table (Id).Compile_Errors := True;
822 Detect_Blocking := True;
824 -- Processing for FD/FG/FI
827 Float_Format_Specified := Getc;
828 ALIs.Table (Id).Float_Format := Float_Format_Specified;
833 Locking_Policy_Specified := Getc;
834 ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
836 -- Processing for flags starting with N
844 ALIs.Table (Id).No_Object := True;
845 No_Object_Specified := True;
850 No_Run_Time_Mode := True;
851 Configurable_Run_Time_Mode := True;
856 ALIs.Table (Id).Normalize_Scalars := True;
857 Normalize_Scalars_Specified := True;
860 -- Invalid switch starting with N
869 Queuing_Policy_Specified := Getc;
870 ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
872 -- Processing for flags starting with S
880 ALIs.Table (Id).Interface := True;
885 Opt.Sec_Stack_Used := True;
887 -- Invalid switch starting with S
896 Task_Dispatching_Policy_Specified := Getc;
897 ALIs.Table (Id).Task_Dispatching_Policy :=
898 Task_Dispatching_Policy_Specified;
900 -- Processing for switch starting with U
908 Unreserve_All_Interrupts_Specified := True;
913 ALIs.Table (Id).Unit_Exception_Table := True;
915 -- Invalid switches starting with U
927 ALIs.Table (Id).Zero_Cost_Exceptions := True;
928 Zero_Cost_Exceptions_Specified := True;
942 No_Normalize_Scalars_Specified := True;
951 -- Acquire restrictions line
954 if Ignore_Errors then
969 -- Process restrictions line
972 Scan_Restrictions : declare
973 Save_R : constant Restrictions_Info := Cumulative_Restrictions;
974 -- Save cumulative restrictions in case we have a fatal error
976 Bad_R_Line : exception;
977 -- Signal bad restrictions line
983 -- Acquire information for boolean restrictions
985 for R in All_Boolean_Restrictions loop
990 ALIs.Table (Id).Restrictions.Violated (R) := True;
991 Cumulative_Restrictions.Violated (R) := True;
994 ALIs.Table (Id).Restrictions.Set (R) := True;
995 Cumulative_Restrictions.Set (R) := True;
1005 -- Acquire information for parameter restrictions
1007 for RP in All_Parameter_Restrictions loop
1009 -- Acquire restrictions pragma information
1016 ALIs.Table (Id).Restrictions.Set (RP) := True;
1019 N : constant Integer := Integer (Get_Nat);
1021 ALIs.Table (Id).Restrictions.Value (RP) := N;
1023 if Cumulative_Restrictions.Set (RP) then
1024 Cumulative_Restrictions.Value (RP) :=
1026 (Cumulative_Restrictions.Value (RP), N);
1028 Cumulative_Restrictions.Set (RP) := True;
1029 Cumulative_Restrictions.Value (RP) := N;
1037 -- Acquire restrictions violations information
1044 ALIs.Table (Id).Restrictions.Violated (RP) := True;
1045 Cumulative_Restrictions.Violated (RP) := True;
1048 N : constant Integer := Integer (Get_Nat);
1049 pragma Unsuppress (Overflow_Check);
1052 ALIs.Table (Id).Restrictions.Count (RP) := N;
1054 if RP in Checked_Max_Parameter_Restrictions then
1055 Cumulative_Restrictions.Count (RP) :=
1057 (Cumulative_Restrictions.Count (RP), N);
1059 Cumulative_Restrictions.Count (RP) :=
1060 Cumulative_Restrictions.Count (RP) + N;
1064 when Constraint_Error =>
1066 -- A constraint error comes from the addition in
1067 -- the else branch. We reset to the maximum and
1068 -- indicate that the real value is now unknown.
1070 Cumulative_Restrictions.Value (RP) := Integer'Last;
1071 Cumulative_Restrictions.Unknown (RP) := True;
1076 ALIs.Table (Id).Restrictions.Unknown (RP) := True;
1077 Cumulative_Restrictions.Unknown (RP) := True;
1087 -- Here if error during scanning of restrictions line
1092 -- In Ignore_Errors mode, undo any changes to restrictions
1093 -- from this unit, and continue on.
1095 if Ignore_Errors then
1096 Cumulative_Restrictions := Save_R;
1097 ALIs.Table (Id).Restrictions := Restrictions_Initial;
1099 -- In normal mode, this is a fatal error
1105 end Scan_Restrictions;
1108 -- Acquire 'I
' lines if present
1114 if Ignore ('I
') then
1120 I_State : Character;
1129 Interrupt_States.Append (
1130 (Interrupt_Id => Int_Num,
1131 Interrupt_State => I_State,
1132 IS_Pragma_Line => Line_No));
1134 ALIs.Table (Id).Last_Interrupt_State := Interrupt_States.Last;
1142 -- Loop to acquire unit entries
1146 exit U_Loop when C /= 'U
';
1148 -- Note: as per spec, we never ignore U lines
1152 Units.Increment_Last;
1154 if ALIs.Table (Id).First_Unit = No_Unit_Id then
1155 ALIs.Table (Id).First_Unit := Units.Last;
1158 Units.Table (Units.Last).Uname := Get_Name;
1159 Units.Table (Units.Last).Predefined := Is_Predefined_Unit;
1160 Units.Table (Units.Last).Internal := Is_Internal_Unit;
1161 Units.Table (Units.Last).My_ALI := Id;
1162 Units.Table (Units.Last).Sfile := Get_Name (Lower => True);
1163 Units.Table (Units.Last).Pure := False;
1164 Units.Table (Units.Last).Preelab := False;
1165 Units.Table (Units.Last).No_Elab := False;
1166 Units.Table (Units.Last).Shared_Passive := False;
1167 Units.Table (Units.Last).RCI := False;
1168 Units.Table (Units.Last).Remote_Types := False;
1169 Units.Table (Units.Last).Has_RACW := False;
1170 Units.Table (Units.Last).Init_Scalars := False;
1171 Units.Table (Units.Last).Is_Generic := False;
1172 Units.Table (Units.Last).Icasing := Mixed_Case;
1173 Units.Table (Units.Last).Kcasing := All_Lower_Case;
1174 Units.Table (Units.Last).Dynamic_Elab := False;
1175 Units.Table (Units.Last).Elaborate_Body := False;
1176 Units.Table (Units.Last).Set_Elab_Entity := False;
1177 Units.Table (Units.Last).Version := "00000000";
1178 Units.Table (Units.Last).First_With := Withs.Last + 1;
1179 Units.Table (Units.Last).First_Arg := First_Arg;
1180 Units.Table (Units.Last).Elab_Position := 0;
1181 Units.Table (Units.Last).Interface := ALIs.Table (Id).Interface;
1182 Units.Table (Units.Last).Body_Needed_For_SAL := False;
1184 if Debug_Flag_U then
1185 Write_Str (" ----> reading unit ");
1186 Write_Int (Int (Units.Last));
1188 Write_Unit_Name (Units.Table (Units.Last).Uname);
1189 Write_Str (" from file ");
1190 Write_Name (Units.Table (Units.Last).Sfile);
1194 -- Check for duplicated unit in different files
1197 Info : constant Int := Get_Name_Table_Info
1198 (Units.Table (Units.Last).Uname);
1201 and then Units.Table (Units.Last).Sfile /=
1202 Units.Table (Unit_Id (Info)).Sfile
1204 -- If Err is set then ignore duplicate unit name. This is the
1205 -- case of a call from gnatmake, where the situation can arise
1206 -- from substitution of source files. In such situations, the
1207 -- processing in gnatmake will always result in any required
1208 -- recompilations in any case, and if we consider this to be
1209 -- an error we get strange cases (for example when a generic
1210 -- instantiation is replaced by a normal package) where we
1211 -- read the old ali file, decide to recompile, and then decide
1212 -- that the old and new ali files are incompatible.
1217 -- If Err is not set, then this is a fatal error. This is
1218 -- the case of being called from the binder, where we must
1219 -- definitely diagnose this as an error.
1223 Write_Str ("error: duplicate unit name: ");
1226 Write_Str ("error: unit """);
1227 Write_Unit_Name (Units.Table (Units.Last).Uname);
1228 Write_Str (""" found in file """);
1229 Write_Name_Decoded (Units.Table (Units.Last).Sfile);
1233 Write_Str ("error
: unit
""");
1234 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1235 Write_Str (""" found
in file
""");
1236 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1240 Exit_Program (E_Fatal);
1246 (Units.Table (Units.Last).Uname, Int (Units.Last));
1248 -- Scan out possible version and other parameters
1257 if C in '0' .. '9' or else C in 'a
' .. 'f
' then
1258 Units.Table (Units.Last).Version (1) := C;
1260 for J in 2 .. 8 loop
1262 Units.Table (Units.Last).Version (J) := C;
1265 -- BN parameter (Body needed)
1271 Check_At_End_Of_Field;
1272 Units.Table (Units.Last).Body_Needed_For_SAL := True;
1278 -- DE parameter (Dynamic elaboration checks)
1284 Check_At_End_Of_Field;
1285 Units.Table (Units.Last).Dynamic_Elab := True;
1286 Dynamic_Elaboration_Checks_Specified := True;
1297 Units.Table (Units.Last).Elaborate_Body := True;
1299 Units.Table (Units.Last).Set_Elab_Entity := True;
1304 Check_At_End_Of_Field;
1306 -- GE parameter (generic)
1312 Check_At_End_Of_Field;
1313 Units.Table (Units.Last).Is_Generic := True;
1318 -- IL/IS/IU parameters
1324 Units.Table (Units.Last).Icasing := All_Lower_Case;
1326 Units.Table (Units.Last).Init_Scalars := True;
1327 Initialize_Scalars_Used := True;
1329 Units.Table (Units.Last).Icasing := All_Upper_Case;
1334 Check_At_End_Of_Field;
1342 Units.Table (Units.Last).Kcasing := Mixed_Case;
1344 Units.Table (Units.Last).Kcasing := All_Upper_Case;
1349 Check_At_End_Of_Field;
1357 Units.Table (Units.Last).No_Elab := True;
1358 Check_At_End_Of_Field;
1364 -- PR/PU/PK parameters
1370 Units.Table (Units.Last).Preelab := True;
1372 Units.Table (Units.Last).Pure := True;
1374 Units.Table (Units.Last).Unit_Kind := 'p
';
1379 Check_At_End_Of_Field;
1387 Units.Table (Units.Last).RCI := True;
1389 Units.Table (Units.Last).Remote_Types := True;
1391 Units.Table (Units.Last).Has_RACW := True;
1396 Check_At_End_Of_Field;
1402 Units.Table (Units.Last).Shared_Passive := True;
1404 Units.Table (Units.Last).Unit_Kind := 's
';
1409 Check_At_End_Of_Field;
1419 -- Check if static elaboration model used
1421 if not Units.Table (Units.Last).Dynamic_Elab
1422 and then not Units.Table (Units.Last).Internal
1424 Static_Elaboration_Model_Used := True;
1429 -- Scan out With lines for this unit
1433 exit With_Loop when C /= 'W
';
1435 if Ignore ('W
') then
1441 Withs.Increment_Last;
1442 Withs.Table (Withs.Last).Uname := Get_Name;
1443 Withs.Table (Withs.Last).Elaborate := False;
1444 Withs.Table (Withs.Last).Elaborate_All := False;
1445 Withs.Table (Withs.Last).Elab_All_Desirable := False;
1446 Withs.Table (Withs.Last).Interface := False;
1448 -- Generic case with no object file available
1451 Withs.Table (Withs.Last).Sfile := No_File;
1452 Withs.Table (Withs.Last).Afile := No_File;
1457 Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
1458 Withs.Table (Withs.Last).Afile := Get_Name;
1460 -- Scan out possible E, EA, and NE parameters
1462 while not At_Eol loop
1468 if At_End_Of_Field then
1469 Withs.Table (Withs.Last).Elaborate := True;
1471 elsif Nextc = 'A
' then
1473 Check_At_End_Of_Field;
1474 Withs.Table (Withs.Last).Elaborate_All := True;
1478 Check_At_End_Of_Field;
1480 -- Store ED indication unless ignore required
1482 if not Ignore_ED then
1483 Withs.Table (Withs.Last).Elab_All_Desirable :=
1497 Units.Table (Units.Last).Last_With := Withs.Last;
1498 Units.Table (Units.Last).Last_Arg := Args.Last;
1500 -- If there are linker options lines present, scan them
1504 Linker_Options_Loop : loop
1506 exit Linker_Options_Loop when C /= 'L
';
1508 if Ignore ('L
') then
1519 if C < Character'Val (16#20#)
1520 or else C > Character'Val (16#7E#)
1525 C := Character'Val (0);
1532 for J in 1 .. 2 loop
1535 if C in '0' .. '9' then
1538 Character'Pos ('0');
1540 elsif C in 'A' .. 'F' then
1543 Character'Pos ('A') +
1552 Add_Char_To_Name_Buffer (Character'Val (V));
1557 exit when Nextc /= '"';
1561 Add_Char_To_Name_Buffer (C);
1565 Add_Char_To_Name_Buffer (nul);
1570 end loop Linker_Options_Loop;
1572 -- Store the linker options entry if one was found
1574 if Name_Len /= 0 then
1575 Linker_Options.Increment_Last;
1577 Linker_Options.Table (Linker_Options.Last).Name :=
1580 Linker_Options.Table (Linker_Options.Last).Unit :=
1583 Linker_Options.Table (Linker_Options.Last).Internal_File :=
1584 Is_Internal_File_Name (F);
1586 Linker_Options.Table (Linker_Options.Last).Original_Pos :=
1587 Linker_Options.Last;
1591 -- End loop through units for one ALI file
1593 ALIs.Table (Id).Last_Unit := Units.Last;
1594 ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
1596 -- Set types of the units (there can be at most 2 of them)
1598 if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
1599 Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
1600 Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
1603 -- Deal with body only and spec only cases, note that the reason we
1604 -- do our own checking of the name (rather than using Is_Body_Name)
1605 -- is that Uname drags in far too much compiler junk!
1607 Get_Name_String (Units.Table (Units.Last).Uname);
1609 if Name_Buffer (Name_Len) = 'b' then
1610 Units.Table (Units.Last).Utype := Is_Body_Only;
1612 Units.Table (Units.Last).Utype := Is_Spec_Only;
1616 -- Scan out external version references and put in hash table
1620 exit E_Loop when C /= 'E';
1622 if Ignore ('E') then
1638 exit when At_End_Of_Field;
1639 Add_Char_To_Name_Buffer (C);
1642 Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
1649 -- Scan out source dependency lines for this ALI file
1651 ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
1655 exit D_Loop when C /= 'D';
1657 if Ignore ('D') then
1663 Sdep.Increment_Last;
1664 Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True);
1665 Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
1666 Sdep.Table (Sdep.Last).Dummy_Entry :=
1667 (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
1669 -- Acquire checksum value
1682 exit when At_Eol or else Ctr = 8;
1684 if Nextc in '0' .. '9' then
1686 Character'Pos (Nextc) - Character'Pos ('0');
1688 elsif Nextc in 'a' .. 'f' then
1690 Character'Pos (Nextc) - Character'Pos ('a') + 10;
1700 if Ctr = 8 and then At_End_Of_Field then
1701 Sdep.Table (Sdep.Last).Checksum := Chk;
1707 -- Acquire subunit and reference file name entries
1709 Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
1710 Sdep.Table (Sdep.Last).Rfile :=
1711 Sdep.Table (Sdep.Last).Sfile;
1712 Sdep.Table (Sdep.Last).Start_Line := 1;
1717 -- Here for subunit name
1719 if Nextc not in '0' .. '9' then
1722 while not At_End_Of_Field loop
1723 Name_Len := Name_Len + 1;
1724 Name_Buffer (Name_Len) := Getc;
1727 Sdep.Table (Sdep.Last).Subunit_Name := Name_Enter;
1731 -- Here for reference file name entry
1733 if Nextc in '0' .. '9' then
1734 Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
1739 while not At_End_Of_Field loop
1740 Name_Len := Name_Len + 1;
1741 Name_Buffer (Name_Len) := Getc;
1744 Sdep.Table (Sdep.Last).Rfile := Name_Enter;
1754 ALIs.Table (Id).Last_Sdep := Sdep.Last;
1756 -- We must at this stage be at an Xref line or the end of file
1768 -- If we are ignoring Xref sections we are done (we ignore all
1769 -- remaining lines since only xref related lines follow X).
1771 if Ignore ('X') and then not Debug_Flag_X then
1775 -- Loop through Xref sections
1779 exit X_Loop when C /= 'X';
1781 -- Make new entry in section table
1783 Xref_Section.Increment_Last;
1785 Read_Refs_For_One_File : declare
1786 XS : Xref_Section_Record renames
1787 Xref_Section.Table (Xref_Section.Last);
1789 Current_File_Num : Sdep_Id;
1790 -- Keeps track of the current file number (changed by nn|)
1793 XS.File_Num := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
1794 XS.File_Name := Get_Name;
1795 XS.First_Entity := Xref_Entity.Last + 1;
1797 Current_File_Num := XS.File_Num;
1804 -- Loop through Xref entities
1806 while C /= 'X' and then C /= EOF loop
1807 Xref_Entity.Increment_Last;
1809 Read_Refs_For_One_Entity : declare
1810 XE : Xref_Entity_Record renames
1811 Xref_Entity.Table (Xref_Entity.Last);
1814 procedure Read_Instantiation_Reference;
1815 -- Acquire instantiation reference. Caller has checked
1816 -- that current character is '[' and on return the cursor
1817 -- is skipped past the corresponding closing ']'.
1819 ----------------------------------
1820 -- Read_Instantiation_Reference --
1821 ----------------------------------
1823 procedure Read_Instantiation_Reference is
1824 Local_File_Num : Sdep_Id := Current_File_Num;
1827 Xref.Increment_Last;
1830 XR : Xref_Record renames Xref.Table (Xref.Last);
1833 P := P + 1; -- skip [
1838 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1839 Local_File_Num := XR.File_Num;
1844 XR.File_Num := Local_File_Num;
1851 -- Recursive call for next reference
1854 pragma Warnings (Off); -- kill recursion warning
1855 Read_Instantiation_Reference;
1856 pragma Warnings (On);
1859 -- Skip closing bracket after recursive call
1863 end Read_Instantiation_Reference;
1865 -- Start of processing for Read_Refs_For_One_Entity
1871 XE.Lib := (Getc = '*');
1872 XE.Entity := Get_Name;
1874 Current_File_Num := XS.File_Num;
1876 -- Renaming reference is present
1880 XE.Rref_Line := Get_Nat;
1886 XE.Rref_Col := Get_Nat;
1888 -- No renaming reference present
1897 -- See if type reference present
1900 when '<' => XE.Tref := Tref_Derived;
1901 when '(' => XE.Tref := Tref_Access;
1902 when '{' => XE.Tref := Tref_Type;
1903 when others => XE.Tref := Tref_None;
1906 -- Case of typeref field present
1908 if XE.Tref /= Tref_None then
1909 P := P + 1; -- skip opening bracket
1911 if Nextc in 'a' .. 'z' then
1912 XE.Tref_File_Num := No_Sdep_Id;
1914 XE.Tref_Type := ' ';
1916 XE.Tref_Standard_Entity :=
1917 Get_Name (Ignore_Spaces => True);
1924 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1929 XE.Tref_File_Num := Current_File_Num;
1933 XE.Tref_Type := Getc;
1934 XE.Tref_Col := Get_Nat;
1935 XE.Tref_Standard_Entity := No_Name;
1938 -- ??? Temporary workaround for nested generics case:
1939 -- 4i4 Directories{1|4I9[4|6[3|3]]}
1943 Nested_Brackets : Natural := 0;
1949 Nested_Brackets := Nested_Brackets + 1;
1951 Nested_Brackets := Nested_Brackets - 1;
1953 if Nested_Brackets = 0 then
1962 P := P + 1; -- skip closing bracket
1965 -- No typeref entry present
1968 XE.Tref_File_Num := No_Sdep_Id;
1970 XE.Tref_Type := ' ';
1972 XE.Tref_Standard_Entity := No_Name;
1975 XE.First_Xref := Xref.Last + 1;
1977 -- Loop through cross-references for this entity
1984 exit when Nextc /= '.';
1988 Xref.Increment_Last;
1991 XR : Xref_Record renames Xref.Table (Xref.Last);
1998 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1999 Current_File_Num := XR.File_Num;
2003 XR.File_Num := Current_File_Num;
2009 -- Imported entities reference as in:
2010 -- 494b<c,__gnat_copy_attribs>25
2011 -- ??? Simply skipped for now
2014 while Getc /= '>' loop
2022 Read_Instantiation_Reference;
2027 -- Record last cross-reference
2029 XE.Last_Xref := Xref.Last;
2031 end Read_Refs_For_One_Entity;
2034 -- Record last entity
2036 XS.Last_Entity := Xref_Entity.Last;
2038 end Read_Refs_For_One_File;
2043 -- Here after dealing with xref sections
2045 if C /= EOF and then C /= 'X' then
2052 when Bad_ALI_Format =>
2061 function SEq (F1, F2 : String_Ptr) return Boolean is
2063 return F1.all = F2.all;
2070 function SHash (S : String_Ptr) return Vindex is
2075 for J in S.all'Range loop
2076 H := H * 2 + Character'Pos (S (J));
2079 return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));