1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             P U T _ A L F A                              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 2011-2012, Free Software Foundation, Inc.         --
10--                                                                          --
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.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26with Alfa; use Alfa;
27
28procedure Put_Alfa is
29begin
30   --  Loop through entries in Alfa_File_Table
31
32   for J in 1 .. Alfa_File_Table.Last loop
33      declare
34         F     : Alfa_File_Record renames Alfa_File_Table.Table (J);
35         Start : Scope_Index;
36         Stop  : Scope_Index;
37
38      begin
39         Start := F.From_Scope;
40         Stop  := F.To_Scope;
41
42         Write_Info_Initiate ('F');
43         Write_Info_Char ('D');
44         Write_Info_Char (' ');
45         Write_Info_Nat (F.File_Num);
46         Write_Info_Char (' ');
47
48         for N in F.File_Name'Range loop
49            Write_Info_Char (F.File_Name (N));
50         end loop;
51
52         --  If file is a subunit, print the file name for the unit
53
54         if F.Unit_File_Name /= null then
55            Write_Info_Char (' ');
56            Write_Info_Char ('-');
57            Write_Info_Char ('>');
58            Write_Info_Char (' ');
59
60            for N in F.Unit_File_Name'Range loop
61               Write_Info_Char (F.Unit_File_Name (N));
62            end loop;
63         end if;
64
65         Write_Info_Terminate;
66
67         --  Loop through scope entries for this file
68
69         loop
70            exit when Start = Stop + 1;
71            pragma Assert (Start <= Stop);
72
73            declare
74               S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Start);
75
76            begin
77               Write_Info_Initiate ('F');
78               Write_Info_Char ('S');
79               Write_Info_Char (' ');
80               Write_Info_Char ('.');
81               Write_Info_Nat (S.Scope_Num);
82               Write_Info_Char (' ');
83               Write_Info_Nat (S.Line);
84               Write_Info_Char (S.Stype);
85               Write_Info_Nat (S.Col);
86               Write_Info_Char (' ');
87
88               pragma Assert (S.Scope_Name.all /= "");
89
90               for N in S.Scope_Name'Range loop
91                  Write_Info_Char (S.Scope_Name (N));
92               end loop;
93
94               if S.Spec_File_Num /= 0 then
95                  Write_Info_Char (' ');
96                  Write_Info_Char ('-');
97                  Write_Info_Char ('>');
98                  Write_Info_Char (' ');
99                  Write_Info_Nat (S.Spec_File_Num);
100                  Write_Info_Char ('.');
101                  Write_Info_Nat (S.Spec_Scope_Num);
102               end if;
103
104               Write_Info_Terminate;
105            end;
106
107            Start := Start + 1;
108         end loop;
109      end;
110   end loop;
111
112   --  Loop through entries in Alfa_File_Table
113
114   for J in 1 .. Alfa_File_Table.Last loop
115      declare
116         F           : Alfa_File_Record renames Alfa_File_Table.Table (J);
117         Start       : Scope_Index;
118         Stop        : Scope_Index;
119         File        : Nat;
120         Scope       : Nat;
121         Entity_Line : Nat;
122         Entity_Col  : Nat;
123
124      begin
125         Start := F.From_Scope;
126         Stop  := F.To_Scope;
127
128         --  Loop through scope entries for this file
129
130         loop
131            exit when Start = Stop + 1;
132            pragma Assert (Start <= Stop);
133
134            Output_One_Scope : declare
135               S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Start);
136
137               XStart : Xref_Index;
138               XStop  : Xref_Index;
139
140            begin
141               XStart := S.From_Xref;
142               XStop  := S.To_Xref;
143
144               if XStart > XStop then
145                  goto Continue;
146               end if;
147
148               Write_Info_Initiate ('F');
149               Write_Info_Char ('X');
150               Write_Info_Char (' ');
151               Write_Info_Nat (F.File_Num);
152               Write_Info_Char (' ');
153
154               for N in F.File_Name'Range loop
155                  Write_Info_Char (F.File_Name (N));
156               end loop;
157
158               Write_Info_Char (' ');
159               Write_Info_Char ('.');
160               Write_Info_Nat (S.Scope_Num);
161               Write_Info_Char (' ');
162
163               for N in S.Scope_Name'Range loop
164                  Write_Info_Char (S.Scope_Name (N));
165               end loop;
166
167               --  Default value of (0,0) is used for the special __HEAP
168               --  variable so use another default value.
169
170               Entity_Line := 0;
171               Entity_Col  := 1;
172
173               --  Loop through cross reference entries for this scope
174
175               loop
176                  exit when XStart = XStop + 1;
177                  pragma Assert (XStart <= XStop);
178
179                  Output_One_Xref : declare
180                     R : Alfa_Xref_Record renames
181                           Alfa_Xref_Table.Table (XStart);
182
183                  begin
184                     if R.Entity_Line /= Entity_Line
185                       or else R.Entity_Col /= Entity_Col
186                     then
187                        Write_Info_Terminate;
188
189                        Write_Info_Initiate ('F');
190                        Write_Info_Char (' ');
191                        Write_Info_Nat (R.Entity_Line);
192                        Write_Info_Char (R.Etype);
193                        Write_Info_Nat (R.Entity_Col);
194                        Write_Info_Char (' ');
195
196                        for N in R.Entity_Name'Range loop
197                           Write_Info_Char (R.Entity_Name (N));
198                        end loop;
199
200                        Entity_Line := R.Entity_Line;
201                        Entity_Col  := R.Entity_Col;
202                        File        := F.File_Num;
203                        Scope       := S.Scope_Num;
204                     end if;
205
206                     if Write_Info_Col > 72 then
207                        Write_Info_Terminate;
208                        Write_Info_Initiate ('.');
209                     end if;
210
211                     Write_Info_Char (' ');
212
213                     if R.File_Num /= File then
214                        Write_Info_Nat (R.File_Num);
215                        Write_Info_Char ('|');
216                        File  := R.File_Num;
217                        Scope := 0;
218                     end if;
219
220                     if R.Scope_Num /= Scope then
221                        Write_Info_Char ('.');
222                        Write_Info_Nat (R.Scope_Num);
223                        Write_Info_Char (':');
224                        Scope := R.Scope_Num;
225                     end if;
226
227                     Write_Info_Nat (R.Line);
228                     Write_Info_Char (R.Rtype);
229                     Write_Info_Nat (R.Col);
230                  end Output_One_Xref;
231
232                  XStart := XStart + 1;
233               end loop;
234
235               Write_Info_Terminate;
236            end Output_One_Scope;
237
238         <<Continue>>
239            Start := Start + 1;
240         end loop;
241      end;
242   end loop;
243end Put_Alfa;
244