1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Butil
; use Butil
;
29 with Debug
; use Debug
;
30 with Fname
; use Fname
;
31 with Namet
; use Namet
;
32 with Osint
; use Osint
;
33 with Output
; use Output
;
38 -- Make control characters visible
44 procedure Initialize_ALI
is
46 -- When (re)initializing ALI data structures the ALI user expects to
47 -- get a fresh set of data structures. Thus we first need to erase the
48 -- marks put in the name table by the previous set of ALI routine calls.
49 -- This loop is empty and harmless the first time in.
51 for J
in ALIs
.First
.. ALIs
.Last
loop
52 Set_Name_Table_Info
(ALIs
.Table
(J
).Afile
, 0);
65 -- Add dummy zero'th item in Linker_Options for the sort function
67 Linker_Options
.Increment_Last
;
69 -- Initialize global variables recording cumulative options in all
70 -- ALI files that are read for a given processing run in gnatbind.
72 Dynamic_Elaboration_Checks_Specified
:= False;
73 Float_Format_Specified
:= ' ';
74 Locking_Policy_Specified
:= ' ';
75 No_Normalize_Scalars_Specified
:= False;
76 No_Object_Specified
:= False;
77 Normalize_Scalars_Specified
:= False;
78 No_Run_Time_Specified
:= False;
79 Queuing_Policy_Specified
:= ' ';
80 Static_Elaboration_Model_Used
:= False;
81 Task_Dispatching_Policy_Specified
:= ' ';
82 Unreserve_All_Interrupts_Specified
:= False;
83 Zero_Cost_Exceptions_Specified
:= False;
96 Read_Xref
: Boolean := False)
99 P
: Text_Ptr
:= T
'First;
100 Line
: Logical_Line_Number
:= 1;
106 function At_Eol
return Boolean;
107 -- Test if at end of line
109 function At_End_Of_Field
return Boolean;
110 -- Test if at end of line, or if at blank or horizontal tab
112 procedure Check_At_End_Of_Field
;
113 -- Check if we are at end of field, fatal error if not
115 procedure Checkc
(C
: Character);
116 -- Check next character is C. If so bump past it, if not fatal error
118 Bad_ALI_Format
: exception;
120 procedure Fatal_Error
;
121 -- Generate fatal error message for badly formatted ALI file if
122 -- Err is false, or raise Bad_ALI_Format if Err is True.
124 function Getc
return Character;
125 -- Get next character, bumping P past the character obtained
127 function Get_Name
(Lower
: Boolean := False) return Name_Id
;
128 -- Skip blanks, then scan out a name (name is left in Name_Buffer with
129 -- length in Name_Len, as well as being returned in Name_Id form).
130 -- If Lower is set to True then the Name_Buffer will be converted to
131 -- all lower case, for systems where file names are not case sensitive.
132 -- This ensures that gnatbind works correctly regardless of the case
133 -- of the file name on all systems. The name is terminated by a either
134 -- white space or a typeref bracket or an equal sign except for the
135 -- special case of an operator name starting with a double quite which
136 -- is terminated by another double quote.
138 function Get_Nat
return Nat
;
139 -- Skip blanks, then scan out an unsigned integer value in Nat range
141 function Get_Stamp
return Time_Stamp_Type
;
142 -- Skip blanks, then scan out a time stamp
144 function Nextc
return Character;
145 -- Return current character without modifying pointer P
148 -- Skip past end of line (fatal error if not at end of line)
150 procedure Skip_Space
;
151 -- Skip past white space (blanks or horizontal tab)
153 ---------------------
154 -- At_End_Of_Field --
155 ---------------------
157 function At_End_Of_Field
return Boolean is
166 function At_Eol
return Boolean is
168 return Nextc
= EOF
or else Nextc
= CR
or else Nextc
= LF
;
171 ---------------------------
172 -- Check_At_End_Of_Field --
173 ---------------------------
175 procedure Check_At_End_Of_Field
is
177 if not At_End_Of_Field
then
180 end Check_At_End_Of_Field
;
186 procedure Checkc
(C
: Character) is
199 procedure Fatal_Error
is
204 procedure Wchar
(C
: Character);
205 -- Write a single character, replacing horizontal tab by spaces
207 procedure Wchar
(C
: Character) is
212 exit when Col
mod 8 = 0;
221 -- Start of processing for Fatal_Error
225 raise Bad_ALI_Format
;
229 Write_Str
("fatal error: file ");
231 Write_Str
(" is incorrectly formatted");
234 ("make sure you are using consistent versions of gcc/gnatbind");
237 -- Find start of line
242 and then T
(Ptr1
- 1) /= CR
243 and then T
(Ptr1
- 1) /= LF
248 Write_Int
(Int
(Line
));
263 and then T
(Ptr2
) /= CR
264 and then T
(Ptr2
) /= LF
276 if T
(Ptr1
) = HT
then
288 Exit_Program
(E_Fatal
);
295 function Get_Name
(Lower
: Boolean := False) return Name_Id
is
305 Name_Len
:= Name_Len
+ 1;
306 Name_Buffer
(Name_Len
) := Getc
;
308 exit when At_End_Of_Field
;
310 if Name_Buffer
(1) = '"' then
311 exit when Name_Len
> 1 and then Name_Buffer
(Name_Len
) = '"';
314 exit when At_End_Of_Field
315 or else Nextc
= '(' or else Nextc
= ')'
316 or else Nextc
= '{' or else Nextc
= '}'
317 or else Nextc
= '<' or else Nextc
= '>'
322 -- Convert file name to all lower case if file names are not case
323 -- sensitive. This ensures that we handle names in the canonical
324 -- lower case format, regardless of the actual case.
326 if Lower
and not File_Names_Case_Sensitive
then
327 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
337 function Get_Nat
return Nat
is
346 V
:= V
* 10 + (Character'Pos (Getc
) - Character'Pos ('0'));
347 exit when At_End_Of_Field
;
348 exit when Nextc
< '0' or Nextc
> '9';
358 function Get_Stamp
return Time_Stamp_Type
is
369 -- Following reads old style time stamp missing first two digits
371 if Nextc
in '7' .. '9' then
376 -- Normal case of full year in time stamp
382 for J
in Start
.. T
'Last loop
393 function Getc
return Character is
407 function Nextc
return Character is
416 procedure Skip_Eol
is
419 if not At_Eol
then Fatal_Error
; end if;
421 -- Loop to skip past blank lines (first time through skips this EOL)
423 while Nextc
< ' ' and then Nextc
/= EOF
loop
436 procedure Skip_Space
is
438 while Nextc
= ' ' or else Nextc
= HT
loop
443 --------------------------------------
444 -- Start of processing for Scan_ALI --
445 --------------------------------------
450 Set_Name_Table_Info
(F
, Int
(Id
));
454 Compile_Errors
=> False,
455 First_Sdep
=> No_Sdep_Id
,
456 First_Unit
=> No_Unit_Id
,
458 Last_Sdep
=> No_Sdep_Id
,
459 Last_Unit
=> No_Unit_Id
,
460 Locking_Policy
=> ' ',
462 Main_Program
=> None
,
464 No_Run_Time
=> False,
465 Normalize_Scalars
=> False,
466 Ofile_Full_Name
=> Full_Object_File_Name
,
467 Queuing_Policy
=> ' ',
468 Restrictions
=> (others => ' '),
470 Task_Dispatching_Policy
=> ' ',
471 Time_Slice_Value
=> -1,
473 Unit_Exception_Table
=> False,
474 Ver
=> (others => ' '),
476 Zero_Cost_Exceptions
=> False);
478 -- Acquire library version
485 for J
in 1 .. Ver_Len_Max
loop
488 ALIs
.Table
(Id
).Ver
(J
) := C
;
489 ALIs
.Table
(Id
).Ver_Len
:= J
;
494 -- Acquire main program line if present
505 ALIs
.Table
(Id
).Main_Program
:= Func
;
507 ALIs
.Table
(Id
).Main_Program
:= Proc
;
517 ALIs
.Table
(Id
).Main_Priority
:= Get_Nat
;
525 ALIs
.Table
(Id
).Time_Slice_Value
:= Get_Nat
;
532 ALIs
.Table
(Id
).WC_Encoding
:= Getc
;
540 -- Acquire argument lines
542 First_Arg
:= Args
.Last
+ 1;
544 Arg_Loop
: while C
= 'A' loop
548 while not At_Eol
loop
549 Name_Len
:= Name_Len
+ 1;
550 Name_Buffer
(Name_Len
) := Getc
;
554 Args
.Table
(Args
.Last
) := new String'(Name_Buffer (1 .. Name_Len));
560 -- Acquire P line, first set defaults
568 while not At_Eol loop
575 ALIs.Table (Id).Compile_Errors := True;
578 Float_Format_Specified := Getc;
579 ALIs.Table (Id).Float_Format := Float_Format_Specified;
582 Locking_Policy_Specified := Getc;
583 ALIs.Table (Id).Locking_Policy := Locking_Policy_Specified;
589 ALIs.Table (Id).No_Object := True;
590 No_Object_Specified := True;
593 No_Run_Time_Specified := True;
594 ALIs.Table (Id).No_Run_Time := True;
597 ALIs.Table (Id).Normalize_Scalars := True;
598 Normalize_Scalars_Specified := True;
606 Queuing_Policy_Specified := Getc;
607 ALIs.Table (Id).Queuing_Policy := Queuing_Policy_Specified;
610 Task_Dispatching_Policy_Specified := Getc;
611 ALIs.Table (Id).Task_Dispatching_Policy :=
612 Task_Dispatching_Policy_Specified;
616 Unreserve_All_Interrupts_Specified := True;
621 ALIs.Table (Id).Unit_Exception_Table := True;
626 ALIs.Table (Id).Zero_Cost_Exceptions := True;
627 Zero_Cost_Exceptions_Specified := True;
635 No_Normalize_Scalars_Specified := True;
640 -- Acquire restrictions line
649 for J in All_Restrictions loop
651 ALIs.Table (Id).Restrictions (J) := C;
655 Restrictions (J) := 'v
';
658 if Restrictions (J) = 'n
' then
659 Restrictions (J) := 'r
';
678 -- Loop to acquire unit entries
680 Unit_Loop : while C = 'U
' loop
683 Units.Increment_Last;
685 if ALIs.Table (Id).First_Unit = No_Unit_Id then
686 ALIs.Table (Id).First_Unit := Units.Last;
689 Units.Table (Units.Last).Uname := Get_Name;
690 Units.Table (Units.Last).Predefined := Is_Predefined_Unit;
691 Units.Table (Units.Last).Internal := Is_Internal_Unit;
692 Units.Table (Units.Last).My_ALI := Id;
693 Units.Table (Units.Last).Sfile := Get_Name (Lower => True);
694 Units.Table (Units.Last).Pure := False;
695 Units.Table (Units.Last).Preelab := False;
696 Units.Table (Units.Last).No_Elab := False;
697 Units.Table (Units.Last).Shared_Passive := False;
698 Units.Table (Units.Last).RCI := False;
699 Units.Table (Units.Last).Remote_Types := False;
700 Units.Table (Units.Last).Has_RACW := False;
701 Units.Table (Units.Last).Init_Scalars := False;
702 Units.Table (Units.Last).Is_Generic := False;
703 Units.Table (Units.Last).Icasing := Mixed_Case;
704 Units.Table (Units.Last).Kcasing := All_Lower_Case;
705 Units.Table (Units.Last).Dynamic_Elab := False;
706 Units.Table (Units.Last).Elaborate_Body := False;
707 Units.Table (Units.Last).Set_Elab_Entity := False;
708 Units.Table (Units.Last).Version := "00000000";
709 Units.Table (Units.Last).First_With := Withs.Last + 1;
710 Units.Table (Units.Last).First_Arg := First_Arg;
711 Units.Table (Units.Last).Elab_Position := 0;
714 Write_Str (" ----> reading unit ");
715 Write_Int (Int (Units.Last));
717 Write_Unit_Name (Units.Table (Units.Last).Uname);
718 Write_Str (" from file ");
719 Write_Name (Units.Table (Units.Last).Sfile);
723 -- Check for duplicated unit in different files
726 Info : constant Int := Get_Name_Table_Info
727 (Units.Table (Units.Last).Uname);
730 and then Units.Table (Units.Last).Sfile /=
731 Units.Table (Unit_Id (Info)).Sfile
733 -- If Err is set then ignore duplicate unit name. This is the
734 -- case of a call from gnatmake, where the situation can arise
735 -- from substitution of source files. In such situations, the
736 -- processing in gnatmake will always result in any required
737 -- recompilations in any case, and if we consider this to be
738 -- an error we get strange cases (for example when a generic
739 -- instantiation is replaced by a normal package) where we
740 -- read the old ali file, decide to recompile, and then decide
741 -- that the old and new ali files are incompatible.
746 -- If Err is not set, then this is a fatal error. This is
747 -- the case of being called from the binder, where we must
748 -- definitely diagnose this as an error.
752 Write_Str ("error: duplicate unit name: ");
755 Write_Str ("error: unit """);
756 Write_Unit_Name (Units.Table (Units.Last).Uname);
757 Write_Str (""" found in file """);
758 Write_Name_Decoded (Units.Table (Units.Last).Sfile);
762 Write_Str ("error
: unit
""");
763 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
764 Write_Str (""" found
in file
""");
765 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
769 Exit_Program (E_Fatal);
775 (Units.Table (Units.Last).Uname, Int (Units.Last));
777 -- Scan out possible version and other parameters
786 if C in '0' .. '9' or else C in 'a
' .. 'f
' then
787 Units.Table (Units.Last).Version (1) := C;
791 Units.Table (Units.Last).Version (J) := C;
794 -- DE parameter (Dynamic elaboration checks
798 Check_At_End_Of_Field;
799 Units.Table (Units.Last).Dynamic_Elab := True;
800 Dynamic_Elaboration_Checks_Specified := True;
808 Units.Table (Units.Last).Elaborate_Body := True;
811 Units.Table (Units.Last).Set_Elab_Entity := True;
817 Check_At_End_Of_Field;
819 -- GE parameter (generic)
823 Check_At_End_Of_Field;
824 Units.Table (Units.Last).Is_Generic := True;
826 -- IL/IS/IU parameters
832 Units.Table (Units.Last).Icasing := All_Lower_Case;
835 Units.Table (Units.Last).Init_Scalars := True;
836 Initialize_Scalars_Used := True;
839 Units.Table (Units.Last).Icasing := All_Upper_Case;
845 Check_At_End_Of_Field;
853 Units.Table (Units.Last).Kcasing := Mixed_Case;
856 Units.Table (Units.Last).Kcasing := All_Upper_Case;
862 Check_At_End_Of_Field;
868 Units.Table (Units.Last).No_Elab := True;
869 Check_At_End_Of_Field;
871 -- PR/PU/PK parameters
876 -- PR parameter (preelaborate)
879 Units.Table (Units.Last).Preelab := True;
881 -- PU parameter (pure)
884 Units.Table (Units.Last).Pure := True;
886 -- PK indicates unit is package
889 Units.Table (Units.Last).Unit_Kind := 'p
';
895 Check_At_End_Of_Field;
902 -- RC parameter (remote call interface)
905 Units.Table (Units.Last).RCI := True;
907 -- RT parameter (remote types)
910 Units.Table (Units.Last).Remote_Types := True;
912 -- RA parameter (remote access to class wide type)
915 Units.Table (Units.Last).Has_RACW := True;
921 Check_At_End_Of_Field;
926 -- SP parameter (shared passive)
929 Units.Table (Units.Last).Shared_Passive := True;
931 -- SU parameter indicates unit is subprogram
934 Units.Table (Units.Last).Unit_Kind := 's
';
940 Check_At_End_Of_Field;
950 -- Check if static elaboration model used
952 if not Units.Table (Units.Last).Dynamic_Elab
953 and then not Units.Table (Units.Last).Internal
955 Static_Elaboration_Model_Used := True;
958 -- Scan out With lines for this unit
962 With_Loop : while C = 'W
' loop
965 Withs.Increment_Last;
966 Withs.Table (Withs.Last).Uname := Get_Name;
967 Withs.Table (Withs.Last).Elaborate := False;
968 Withs.Table (Withs.Last).Elaborate_All := False;
969 Withs.Table (Withs.Last).Elab_All_Desirable := False;
971 -- Generic case with no object file available
974 Withs.Table (Withs.Last).Sfile := No_File;
975 Withs.Table (Withs.Last).Afile := No_File;
980 Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
981 Withs.Table (Withs.Last).Afile := Get_Name;
983 -- Scan out possible E, EA, and NE parameters
985 while not At_Eol loop
991 if At_End_Of_Field then
992 Withs.Table (Withs.Last).Elaborate := True;
994 elsif Nextc = 'A
' then
996 Check_At_End_Of_Field;
997 Withs.Table (Withs.Last).Elaborate_All := True;
1001 Check_At_End_Of_Field;
1003 -- Store ED indication unless ignore required
1005 if not Ignore_ED then
1006 Withs.Table (Withs.Last).Elab_All_Desirable := True;
1018 Units.Table (Units.Last).Last_With := Withs.Last;
1019 Units.Table (Units.Last).Last_Arg := Args.Last;
1021 -- If there are linker options lines present, scan them
1025 Linker_Options_Loop : while C = 'L
' loop
1033 if C < Character'Val (16#20#)
1034 or else C > Character'Val (16#7E#)
1039 C := Character'Val (0);
1046 for J in 1 .. 2 loop
1049 if C in '0' .. '9' then
1051 Character'Pos (C) - Character'Pos ('0');
1053 elsif C in 'A' .. 'F' then
1055 Character'Pos (C) - Character'Pos ('A') + 10;
1064 Add_Char_To_Name_Buffer (Character'Val (V));
1069 exit when Nextc /= '"';
1073 Add_Char_To_Name_Buffer (C);
1077 Add_Char_To_Name_Buffer (nul);
1081 end loop Linker_Options_Loop;
1083 -- Store the linker options entry
1085 if Name_Len /= 0 then
1086 Linker_Options.Increment_Last;
1088 Linker_Options.Table (Linker_Options.Last).Name :=
1091 Linker_Options.Table (Linker_Options.Last).Unit :=
1094 Linker_Options.Table (Linker_Options.Last).Internal_File :=
1095 Is_Internal_File_Name (F);
1097 Linker_Options.Table (Linker_Options.Last).Original_Pos :=
1098 Linker_Options.Last;
1102 -- End loop through units for one ALI file
1104 ALIs.Table (Id).Last_Unit := Units.Last;
1105 ALIs.Table (Id).Sfile := Units.Table (ALIs.Table (Id).First_Unit).Sfile;
1107 -- Set types of the units (there can be at most 2 of them)
1109 if ALIs.Table (Id).First_Unit /= ALIs.Table (Id).Last_Unit then
1110 Units.Table (ALIs.Table (Id).First_Unit).Utype := Is_Body;
1111 Units.Table (ALIs.Table (Id).Last_Unit).Utype := Is_Spec;
1114 -- Deal with body only and spec only cases, note that the reason we
1115 -- do our own checking of the name (rather than using Is_Body_Name)
1116 -- is that Uname drags in far too much compiler junk!
1118 Get_Name_String (Units.Table (Units.Last).Uname);
1120 if Name_Buffer (Name_Len) = 'b' then
1121 Units.Table (Units.Last).Utype := Is_Body_Only;
1123 Units.Table (Units.Last).Utype := Is_Spec_Only;
1127 -- Scan out external version references and put in hash table
1142 exit when At_End_Of_Field;
1143 Add_Char_To_Name_Buffer (C);
1146 Version_Ref.Set (new String'(Name_Buffer (1 .. Name_Len)), True);
1151 -- Scan out source dependency lines for this ALI file
1153 ALIs.Table (Id).First_Sdep := Sdep.Last + 1;
1158 Sdep.Increment_Last;
1159 Sdep.Table (Sdep.Last).Sfile := Get_Name (Lower => True);
1160 Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
1161 Sdep.Table (Sdep.Last).Dummy_Entry :=
1162 (Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
1164 -- Acquire checksum value
1177 exit when At_Eol or else Ctr = 8;
1179 if Nextc in '0' .. '9' then
1181 Character'Pos (Nextc) - Character'Pos ('0');
1183 elsif Nextc in 'a' .. 'f' then
1185 Character'Pos (Nextc) - Character'Pos ('a') + 10;
1195 if Ctr = 8 and then At_End_Of_Field then
1196 Sdep.Table (Sdep.Last).Checksum := Chk;
1202 -- Acquire subunit and reference file name entries
1204 Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
1205 Sdep.Table (Sdep.Last).Rfile := Sdep.Table (Sdep.Last).Sfile;
1206 Sdep.Table (Sdep.Last).Start_Line := 1;
1211 -- Here for subunit name
1213 if Nextc not in '0' .. '9' then
1216 while not At_End_Of_Field loop
1217 Name_Len := Name_Len + 1;
1218 Name_Buffer (Name_Len) := Getc;
1221 Sdep.Table (Sdep.Last).Subunit_Name := Name_Enter;
1225 -- Here for reference file name entry
1227 if Nextc in '0' .. '9' then
1228 Sdep.Table (Sdep.Last).Start_Line := Get_Nat;
1233 while not At_End_Of_Field loop
1234 Name_Len := Name_Len + 1;
1235 Name_Buffer (Name_Len) := Getc;
1238 Sdep.Table (Sdep.Last).Rfile := Name_Enter;
1246 ALIs.Table (Id).Last_Sdep := Sdep.Last;
1248 -- Loop through Xref sections (skip loop if not reading xref stuff)
1250 while Read_Xref and then C = 'X' loop
1252 -- Make new entry in section table
1254 Xref_Section.Increment_Last;
1256 Read_Refs_For_One_File : declare
1257 XS : Xref_Section_Record renames
1258 Xref_Section.Table (Xref_Section.Last);
1260 Current_File_Num : Sdep_Id;
1261 -- Keeps track of the current file number (changed by nn|)
1264 XS.File_Num := Sdep_Id (Get_Nat + Nat (First_Sdep_Entry) - 1);
1265 XS.File_Name := Get_Name;
1266 XS.First_Entity := Xref_Entity.Last + 1;
1268 Current_File_Num := XS.File_Num;
1273 -- Loop through Xref entities
1275 while C /= 'X' and then C /= EOF loop
1276 Xref_Entity.Increment_Last;
1278 Read_Refs_For_One_Entity : declare
1280 XE : Xref_Entity_Record renames
1281 Xref_Entity.Table (Xref_Entity.Last);
1285 procedure Read_Instantiation_Reference;
1286 -- Acquire instantiation reference. Caller has checked
1287 -- that current character is '[' and on return the cursor
1288 -- is skipped past the corresponding closing ']'.
1290 ----------------------------------
1291 -- Read_Instantiation_Reference --
1292 ----------------------------------
1294 procedure Read_Instantiation_Reference is
1296 Xref.Increment_Last;
1299 XR : Xref_Record renames Xref.Table (Xref.Last);
1302 P := P + 1; -- skip [
1307 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1308 Current_File_Num := XR.File_Num;
1313 XR.File_Num := Current_File_Num;
1320 -- Recursive call for next reference
1323 pragma Warnings (Off); -- kill recursion warning
1324 Read_Instantiation_Reference;
1325 pragma Warnings (On);
1328 -- Skip closing bracket after recursive call
1332 end Read_Instantiation_Reference;
1334 -- Start of processing for Read_Refs_For_One_Entity
1340 XE.Lib := (Getc = '*');
1341 XE.Entity := Get_Name;
1343 -- Renaming reference is present
1347 XE.Rref_Line := Get_Nat;
1353 XE.Rref_Col := Get_Nat;
1355 -- No renaming reference present
1364 -- See if type reference present
1367 when '<' => XE.Tref := Tref_Derived;
1368 when '(' => XE.Tref := Tref_Access;
1369 when '{' => XE.Tref := Tref_Type;
1370 when others => XE.Tref := Tref_None;
1373 -- Case of typeref field present
1375 if XE.Tref /= Tref_None then
1376 P := P + 1; -- skip opening bracket
1378 if Nextc in 'a' .. 'z' then
1379 XE.Tref_File_Num := No_Sdep_Id;
1381 XE.Tref_Type := ' ';
1383 XE.Tref_Standard_Entity := Get_Name;
1390 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1395 XE.Tref_File_Num := Current_File_Num;
1399 XE.Tref_Type := Getc;
1400 XE.Tref_Col := Get_Nat;
1401 XE.Tref_Standard_Entity := No_Name;
1404 P := P + 1; -- skip closing bracket
1407 -- No typeref entry present
1410 XE.Tref_File_Num := No_Sdep_Id;
1412 XE.Tref_Type := ' ';
1414 XE.Tref_Standard_Entity := No_Name;
1417 XE.First_Xref := Xref.Last + 1;
1419 -- Loop through cross-references for this entity
1421 Current_File_Num := XS.File_Num;
1428 exit when Nextc /= '.';
1432 Xref.Increment_Last;
1435 XR : Xref_Record renames Xref.Table (Xref.Last);
1442 Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
1443 Current_File_Num := XR.File_Num;
1448 XR.File_Num := Current_File_Num;
1456 Read_Instantiation_Reference;
1461 -- Record last cross-reference
1463 XE.Last_Xref := Xref.Last;
1466 end Read_Refs_For_One_Entity;
1469 -- Record last entity
1471 XS.Last_Entity := Xref_Entity.Last;
1473 end Read_Refs_For_One_File;
1478 -- Here after dealing with xref sections
1480 if C /= EOF and then C /= 'X' then
1487 when Bad_ALI_Format =>
1496 function SEq (F1, F2 : String_Ptr) return Boolean is
1498 return F1.all = F2.all;
1505 function SHash (S : String_Ptr) return Vindex is
1510 for J in S.all'Range loop
1511 H := H * 2 + Character'Pos (S (J));
1514 return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));