1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2011, 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 ------------------------------------------------------------------------------
27 with Types
; use Types
;
29 with Ada
.IO_Exceptions
; use Ada
.IO_Exceptions
;
38 -- Dependency number for the current file
41 -- Scope number for the current scope entity
43 Cur_File_Idx
: File_Index
;
44 -- Index in Alfa_File_Table of the current file
46 Cur_Scope_Idx
: Scope_Index
;
47 -- Index in Alfa_Scope_Table of the current scope
49 Name_Str
: String (1 .. 32768);
50 Name_Len
: Natural := 0;
51 -- Local string used to store name of File/entity scanned as
52 -- Name_Str (1 .. Name_Len).
54 -----------------------
55 -- Local Subprograms --
56 -----------------------
58 function At_EOL
return Boolean;
59 -- Skips any spaces, then checks if at the end of a line. If so, returns
60 -- True (but does not skip the EOL sequence). If not, then returns False.
62 procedure Check
(C
: Character);
63 -- Checks that file is positioned at given character, and if so skips past
64 -- it, If not, raises Data_Error.
66 function Get_Nat
return Nat
;
67 -- On entry the file is positioned to a digit. On return, the file is
68 -- positioned past the last digit, and the returned result is the decimal
69 -- value read. Data_Error is raised for overflow (value greater than
70 -- Int'Last), or if the initial character is not a digit.
73 -- On entry the file is positioned to a name. On return, the file is
74 -- positioned past the last character, and the name scanned is returned
75 -- in Name_Str (1 .. Name_Len).
78 -- Called with the current character about to be read being LF or CR. Skips
79 -- past CR/LF characters until either a non-CR/LF character is found, or
80 -- the end of file is encountered.
82 procedure Skip_Spaces
;
83 -- Skips zero or more spaces at the current position, leaving the file
84 -- positioned at the first non-blank character (or Types.EOF).
90 function At_EOL
return Boolean is
93 return Nextc
= CR
or else Nextc
= LF
;
100 procedure Check
(C
: Character) is
113 function Get_Nat
return Nat
is
121 if C
not in '0' .. '9' then
125 -- Loop to read digits of integer value
129 pragma Unsuppress
(Overflow_Check
);
131 Val
:= Val
* 10 + (Character'Pos (C
) - Character'Pos ('0'));
137 exit when C
not in '0' .. '9';
143 when Constraint_Error
=>
151 procedure Get_Name
is
156 while Nextc
> ' ' loop
158 Name_Str
(N
) := Getc
;
168 procedure Skip_EOL
is
175 exit when C
/= LF
and then C
/= CR
;
180 exit when C
/= LF
and then C
/= CR
;
189 procedure Skip_Spaces
is
191 while Nextc
= ' ' loop
196 -- Start of processing for Get_Alfa
199 Initialize_Alfa_Tables
;
206 -- Loop through lines of Alfa information
208 while Nextc
= 'F' loop
213 -- Make sure first line is a File line
215 if Alfa_File_Table
.Last
= 0 and then C
/= 'D' then
219 -- Otherwise dispatch on type of line
223 -- Header entry for scope section
227 -- Complete previous entry if any
229 if Alfa_File_Table
.Last
/= 0 then
230 Alfa_File_Table
.Table
(Alfa_File_Table
.Last
).To_Scope
:=
231 Alfa_Scope_Table
.Last
;
234 -- Scan out dependency number and file name
241 -- Make new File table entry (will fill in To_Scope later)
243 Alfa_File_Table
.Append
(
244 (File_Name
=> new String'(Name_Str (1 .. Name_Len)),
245 File_Num => Cur_File,
246 From_Scope => Alfa_Scope_Table.Last + 1,
249 -- Initialize counter for scopes
275 pragma Assert (Scope = Cur_Scope);
276 pragma Assert (Typ = 'K
'
280 -- Scan out scope entity name
290 Spec_File := Get_Nat;
292 Spec_Scope := Get_Nat;
299 -- Make new scope table entry (will fill in From_Xref and
300 -- To_Xref later). Initial range (From_Xref .. To_Xref) is
301 -- empty for scopes without entities.
303 Alfa_Scope_Table.Append (
304 (Scope_Entity => Empty,
305 Scope_Name => new String'(Name_Str
(1 .. Name_Len
)),
306 File_Num
=> Cur_File
,
307 Scope_Num
=> Cur_Scope
,
308 Spec_File_Num
=> Spec_File
,
309 Spec_Scope_Num
=> Spec_Scope
,
317 -- Update counter for scopes
319 Cur_Scope
:= Cur_Scope
+ 1;
321 -- Header entry for cross-ref section
325 -- Scan out dependency number and file name (ignored)
332 -- Update component From_Xref of current file if first reference
335 while Alfa_File_Table
.Table
(Cur_File_Idx
).File_Num
/= Cur_File
337 Cur_File_Idx
:= Cur_File_Idx
+ 1;
340 -- Scan out scope entity number and entity name (ignored)
344 Cur_Scope
:= Get_Nat
;
348 -- Update component To_Xref of previous scope
350 if Cur_Scope_Idx
/= 0 then
351 Alfa_Scope_Table
.Table
(Cur_Scope_Idx
).To_Xref
:=
352 Alfa_Xref_Table
.Last
;
355 -- Update component From_Xref of current scope
357 Cur_Scope_Idx
:= Alfa_File_Table
.Table
(Cur_File_Idx
).From_Scope
;
359 while Alfa_Scope_Table
.Table
(Cur_Scope_Idx
).Scope_Num
/= Cur_Scope
361 Cur_Scope_Idx
:= Cur_Scope_Idx
+ 1;
364 Alfa_Scope_Table
.Table
(Cur_Scope_Idx
).From_Xref
:=
365 Alfa_Xref_Table
.Last
+ 1;
367 -- Cross reference entry
371 XR_Entity
: String_Ptr
;
372 XR_Entity_Line
: Nat
;
374 XR_Entity_Typ
: Character;
377 -- Keeps track of the current file (changed by nn|)
380 -- Keeps track of the current scope (changed by nn:)
384 XR_Scope
:= Cur_Scope
;
386 XR_Entity_Line
:= Get_Nat
;
387 XR_Entity_Typ
:= Getc
;
388 XR_Entity_Col
:= Get_Nat
;
392 XR_Entity
:= new String'(Name_Str (1 .. Name_Len));
394 -- Initialize to scan items on one line
398 -- Loop through cross-references for this entity
413 exit when Nextc /= '.';
440 Alfa_Xref_Table.Append (
441 (Entity_Name => XR_Entity,
442 Entity_Line => XR_Entity_Line,
443 Etype => XR_Entity_Typ,
444 Entity_Col => XR_Entity_Col,
446 Scope_Num => XR_Scope,
456 -- No other Alfa lines are possible
462 -- For cross reference lines, the EOL character has been skipped already
469 -- Here with all Xrefs stored, complete last entries in File/Scope tables
471 if Alfa_File_Table.Last /= 0 then
472 Alfa_File_Table.Table (Alfa_File_Table.Last).To_Scope :=
473 Alfa_Scope_Table.Last;
476 if Cur_Scope_Idx /= 0 then
477 Alfa_Scope_Table.Table (Cur_Scope_Idx).To_Xref := Alfa_Xref_Table.Last;