11556Srgrimes------------------------------------------------------------------------------
21556Srgrimes--                                                                          --
31556Srgrimes--                         GNAT COMPILER COMPONENTS                         --
41556Srgrimes--                                                                          --
51556Srgrimes--                       P U T _ S P A R K _ X R E F S                      --
61556Srgrimes--                                                                          --
71556Srgrimes--                                 B o d y                                  --
81556Srgrimes--                                                                          --
91556Srgrimes--          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
101556Srgrimes--                                                                          --
111556Srgrimes-- GNAT is free software;  you can  redistribute it  and/or modify it under --
121556Srgrimes-- terms of the  GNU General Public License as published  by the Free Soft- --
131556Srgrimes-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
141556Srgrimes-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
151556Srgrimes-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
161556Srgrimes-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
171556Srgrimes-- for  more details.  You should have  received  a copy of the GNU General --
181556Srgrimes-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
191556Srgrimes-- http://www.gnu.org/licenses for a complete copy of the license.          --
201556Srgrimes--                                                                          --
211556Srgrimes-- GNAT was originally developed  by the GNAT team at  New York University. --
221556Srgrimes-- Extensive contributions were provided by Ada Core Technologies Inc.      --
231556Srgrimes--                                                                          --
241556Srgrimes------------------------------------------------------------------------------
251556Srgrimes
261556Srgrimeswith SPARK_Xrefs; use SPARK_Xrefs;
271556Srgrimes
281556Srgrimesprocedure Put_SPARK_Xrefs is
291556Srgrimesbegin
301556Srgrimes   --  Loop through entries in SPARK_File_Table
311556Srgrimes
321556Srgrimes   for J in 1 .. SPARK_File_Table.Last loop
331556Srgrimes      declare
341556Srgrimes         F     : SPARK_File_Record renames SPARK_File_Table.Table (J);
3535773Scharnier         Start : Scope_Index;
3636006Scharnier         Stop  : Scope_Index;
3735773Scharnier
381556Srgrimes      begin
3999109Sobrien         Start := F.From_Scope;
4099109Sobrien         Stop  := F.To_Scope;
411556Srgrimes
421556Srgrimes         Write_Info_Initiate ('F');
431556Srgrimes         Write_Info_Char ('D');
441556Srgrimes         Write_Info_Char (' ');
451556Srgrimes         Write_Info_Nat (F.File_Num);
461556Srgrimes         Write_Info_Char (' ');
471556Srgrimes
481556Srgrimes         for N in F.File_Name'Range loop
491556Srgrimes            Write_Info_Char (F.File_Name (N));
501556Srgrimes         end loop;
511556Srgrimes
521556Srgrimes         --  If file is a subunit, print the file name for the unit
531556Srgrimes
541556Srgrimes         if F.Unit_File_Name /= null then
551556Srgrimes            Write_Info_Char (' ');
561556Srgrimes            Write_Info_Char ('-');
571556Srgrimes            Write_Info_Char ('>');
581556Srgrimes            Write_Info_Char (' ');
591556Srgrimes
601556Srgrimes            for N in F.Unit_File_Name'Range loop
611556Srgrimes               Write_Info_Char (F.Unit_File_Name (N));
621556Srgrimes            end loop;
631556Srgrimes         end if;
641556Srgrimes
651556Srgrimes         Write_Info_Terminate;
661556Srgrimes
671556Srgrimes         --  Loop through scope entries for this file
681556Srgrimes
691556Srgrimes         loop
701556Srgrimes            exit when Start = Stop + 1;
7190108Simp            pragma Assert (Start <= Stop);
721556Srgrimes
731556Srgrimes            declare
741556Srgrimes               S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Start);
751556Srgrimes
7691079Smarkm            begin
771556Srgrimes               Write_Info_Initiate ('F');
781556Srgrimes               Write_Info_Char ('S');
7998062Skeramida               Write_Info_Char (' ');
8098062Skeramida               Write_Info_Char ('.');
811556Srgrimes               Write_Info_Nat (S.Scope_Num);
821556Srgrimes               Write_Info_Char (' ');
831556Srgrimes               Write_Info_Nat (S.Line);
841556Srgrimes               Write_Info_Char (S.Stype);
851556Srgrimes               Write_Info_Nat (S.Col);
861556Srgrimes               Write_Info_Char (' ');
871556Srgrimes
881556Srgrimes               pragma Assert (S.Scope_Name.all /= "");
891556Srgrimes
901556Srgrimes               for N in S.Scope_Name'Range loop
911556Srgrimes                  Write_Info_Char (S.Scope_Name (N));
921556Srgrimes               end loop;
931556Srgrimes
941556Srgrimes               if S.Spec_File_Num /= 0 then
951556Srgrimes                  Write_Info_Char (' ');
961556Srgrimes                  Write_Info_Char ('-');
971556Srgrimes                  Write_Info_Char ('>');
9891079Smarkm                  Write_Info_Char (' ');
9991079Smarkm                  Write_Info_Nat (S.Spec_File_Num);
1001556Srgrimes                  Write_Info_Char ('.');
10191079Smarkm                  Write_Info_Nat (S.Spec_Scope_Num);
10291079Smarkm               end if;
1031556Srgrimes
1041556Srgrimes               Write_Info_Terminate;
1051556Srgrimes            end;
1061556Srgrimes
1071556Srgrimes            Start := Start + 1;
1081556Srgrimes         end loop;
1091556Srgrimes      end;
1101556Srgrimes   end loop;
1111556Srgrimes
1121556Srgrimes   --  Loop through entries in SPARK_File_Table
1131556Srgrimes
1141556Srgrimes   for J in 1 .. SPARK_File_Table.Last loop
1151556Srgrimes      declare
1161556Srgrimes         F           : SPARK_File_Record renames SPARK_File_Table.Table (J);
1171556Srgrimes         Start       : Scope_Index;
1181556Srgrimes         Stop        : Scope_Index;
1191556Srgrimes         File        : Nat;
12026362Scharnier         Scope       : Nat;
12123622Sguido         Entity_Line : Nat;
1221556Srgrimes         Entity_Col  : Nat;
1231556Srgrimes
1241556Srgrimes      begin
1251556Srgrimes         Start := F.From_Scope;
1261556Srgrimes         Stop  := F.To_Scope;
1271556Srgrimes
1281556Srgrimes         --  Loop through scope entries for this file
1291556Srgrimes
1301556Srgrimes         loop
1311556Srgrimes            exit when Start = Stop + 1;
1321556Srgrimes            pragma Assert (Start <= Stop);
1331556Srgrimes
1341556Srgrimes            Output_One_Scope : declare
1351556Srgrimes               S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Start);
1361556Srgrimes
1371556Srgrimes               XStart : Xref_Index;
1381556Srgrimes               XStop  : Xref_Index;
1391556Srgrimes
1401556Srgrimes            begin
1411556Srgrimes               XStart := S.From_Xref;
1421556Srgrimes               XStop  := S.To_Xref;
1431556Srgrimes
1441556Srgrimes               if XStart > XStop then
1451556Srgrimes                  goto Continue;
14691079Smarkm               end if;
1471556Srgrimes
14891079Smarkm               Write_Info_Initiate ('F');
14991079Smarkm               Write_Info_Char ('X');
15091079Smarkm               Write_Info_Char (' ');
1511556Srgrimes               Write_Info_Nat (F.File_Num);
1521556Srgrimes               Write_Info_Char (' ');
1531556Srgrimes
1541556Srgrimes               for N in F.File_Name'Range loop
1551556Srgrimes                  Write_Info_Char (F.File_Name (N));
1561556Srgrimes               end loop;
1571556Srgrimes
1581556Srgrimes               Write_Info_Char (' ');
1591556Srgrimes               Write_Info_Char ('.');
1601556Srgrimes               Write_Info_Nat (S.Scope_Num);
1611556Srgrimes               Write_Info_Char (' ');
1621556Srgrimes
1631556Srgrimes               for N in S.Scope_Name'Range loop
1641556Srgrimes                  Write_Info_Char (S.Scope_Name (N));
1651556Srgrimes               end loop;
1661556Srgrimes
1671556Srgrimes               --  Default value of (0,0) is used for the special __HEAP
1681556Srgrimes               --  variable so use another default value.
1691556Srgrimes
1701556Srgrimes               Entity_Line := 0;
1711556Srgrimes               Entity_Col  := 1;
1721556Srgrimes
1731556Srgrimes               --  Loop through cross reference entries for this scope
1748855Srgrimes
1751556Srgrimes               loop
1761556Srgrimes                  exit when XStart = XStop + 1;
1771556Srgrimes                  pragma Assert (XStart <= XStop);
1781556Srgrimes
1791556Srgrimes                  Output_One_Xref : declare
1801556Srgrimes                     R : SPARK_Xref_Record renames
1811556Srgrimes                           SPARK_Xref_Table.Table (XStart);
1821556Srgrimes
1831556Srgrimes                  begin
1841556Srgrimes                     if R.Entity_Line /= Entity_Line
1851556Srgrimes                       or else R.Entity_Col /= Entity_Col
1861556Srgrimes                     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_SPARK_Xrefs;
244