06b599fd62
2013-04-24 Yannick Moy <moy@adacore.com> * adabkend.adb, ali-util.adb, ali.adb, debug.adb, errout.adb, errout.ads, erroutc.adb, exp_ch3.adb, exp_ch4.adb, exp_ch6.adb, exp_ch7.adb, exp_dbug.adb, exp_util.adb, expander.adb, freeze.adb, gnat1drv.adb, lib-writ.adb, lib-writ.ads, lib-xref.adb, lib-xref.ads, opt.adb, opt.ads, restrict.adb, sem_aggr.adb, sem_attr.adb, sem_ch3.adb, sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, sem_eval.adb, sem_prag.adb, sem_res.adb, sem_util.adb: Everything with name 'Alfa' renamed in 'SPARK'. Update comments. Renaming of units with name 'Alfa', renamed with 'SPARK' instead. * exp_alfa.adb: renamed exp_spark.adb. * exp_alfa.ads: renamed exp_spark.ads. * get_alfa.adb: renamed get_spark_xrefs.adb. * get_alfa.ads: renamed get_spark_xrefs.ads. * lib-xref-alfa.adb: renamed lib-xref-spark_specific.adb. * put_alfa.adb: renamed put_spark_xrefs.adb. * put_alfa.ads: renamed put_spark_xrefs.ads. * alfa.adb: renamed spark_xrefs.adb. * alfa.ads: renamed spark_xrefs.ads. * alfa_test.adb: renamed spark_xrefs_test.adb. From-SVN: r198234
244 lines
8.4 KiB
Ada
244 lines
8.4 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P U T _ S P A R K _ X R E F S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with SPARK_Xrefs; use SPARK_Xrefs;
|
|
|
|
procedure Put_SPARK_Xrefs is
|
|
begin
|
|
-- Loop through entries in SPARK_File_Table
|
|
|
|
for J in 1 .. SPARK_File_Table.Last loop
|
|
declare
|
|
F : SPARK_File_Record renames SPARK_File_Table.Table (J);
|
|
Start : Scope_Index;
|
|
Stop : Scope_Index;
|
|
|
|
begin
|
|
Start := F.From_Scope;
|
|
Stop := F.To_Scope;
|
|
|
|
Write_Info_Initiate ('F');
|
|
Write_Info_Char ('D');
|
|
Write_Info_Char (' ');
|
|
Write_Info_Nat (F.File_Num);
|
|
Write_Info_Char (' ');
|
|
|
|
for N in F.File_Name'Range loop
|
|
Write_Info_Char (F.File_Name (N));
|
|
end loop;
|
|
|
|
-- If file is a subunit, print the file name for the unit
|
|
|
|
if F.Unit_File_Name /= null then
|
|
Write_Info_Char (' ');
|
|
Write_Info_Char ('-');
|
|
Write_Info_Char ('>');
|
|
Write_Info_Char (' ');
|
|
|
|
for N in F.Unit_File_Name'Range loop
|
|
Write_Info_Char (F.Unit_File_Name (N));
|
|
end loop;
|
|
end if;
|
|
|
|
Write_Info_Terminate;
|
|
|
|
-- Loop through scope entries for this file
|
|
|
|
loop
|
|
exit when Start = Stop + 1;
|
|
pragma Assert (Start <= Stop);
|
|
|
|
declare
|
|
S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Start);
|
|
|
|
begin
|
|
Write_Info_Initiate ('F');
|
|
Write_Info_Char ('S');
|
|
Write_Info_Char (' ');
|
|
Write_Info_Char ('.');
|
|
Write_Info_Nat (S.Scope_Num);
|
|
Write_Info_Char (' ');
|
|
Write_Info_Nat (S.Line);
|
|
Write_Info_Char (S.Stype);
|
|
Write_Info_Nat (S.Col);
|
|
Write_Info_Char (' ');
|
|
|
|
pragma Assert (S.Scope_Name.all /= "");
|
|
|
|
for N in S.Scope_Name'Range loop
|
|
Write_Info_Char (S.Scope_Name (N));
|
|
end loop;
|
|
|
|
if S.Spec_File_Num /= 0 then
|
|
Write_Info_Char (' ');
|
|
Write_Info_Char ('-');
|
|
Write_Info_Char ('>');
|
|
Write_Info_Char (' ');
|
|
Write_Info_Nat (S.Spec_File_Num);
|
|
Write_Info_Char ('.');
|
|
Write_Info_Nat (S.Spec_Scope_Num);
|
|
end if;
|
|
|
|
Write_Info_Terminate;
|
|
end;
|
|
|
|
Start := Start + 1;
|
|
end loop;
|
|
end;
|
|
end loop;
|
|
|
|
-- Loop through entries in SPARK_File_Table
|
|
|
|
for J in 1 .. SPARK_File_Table.Last loop
|
|
declare
|
|
F : SPARK_File_Record renames SPARK_File_Table.Table (J);
|
|
Start : Scope_Index;
|
|
Stop : Scope_Index;
|
|
File : Nat;
|
|
Scope : Nat;
|
|
Entity_Line : Nat;
|
|
Entity_Col : Nat;
|
|
|
|
begin
|
|
Start := F.From_Scope;
|
|
Stop := F.To_Scope;
|
|
|
|
-- Loop through scope entries for this file
|
|
|
|
loop
|
|
exit when Start = Stop + 1;
|
|
pragma Assert (Start <= Stop);
|
|
|
|
Output_One_Scope : declare
|
|
S : SPARK_Scope_Record renames SPARK_Scope_Table.Table (Start);
|
|
|
|
XStart : Xref_Index;
|
|
XStop : Xref_Index;
|
|
|
|
begin
|
|
XStart := S.From_Xref;
|
|
XStop := S.To_Xref;
|
|
|
|
if XStart > XStop then
|
|
goto Continue;
|
|
end if;
|
|
|
|
Write_Info_Initiate ('F');
|
|
Write_Info_Char ('X');
|
|
Write_Info_Char (' ');
|
|
Write_Info_Nat (F.File_Num);
|
|
Write_Info_Char (' ');
|
|
|
|
for N in F.File_Name'Range loop
|
|
Write_Info_Char (F.File_Name (N));
|
|
end loop;
|
|
|
|
Write_Info_Char (' ');
|
|
Write_Info_Char ('.');
|
|
Write_Info_Nat (S.Scope_Num);
|
|
Write_Info_Char (' ');
|
|
|
|
for N in S.Scope_Name'Range loop
|
|
Write_Info_Char (S.Scope_Name (N));
|
|
end loop;
|
|
|
|
-- Default value of (0,0) is used for the special __HEAP
|
|
-- variable so use another default value.
|
|
|
|
Entity_Line := 0;
|
|
Entity_Col := 1;
|
|
|
|
-- Loop through cross reference entries for this scope
|
|
|
|
loop
|
|
exit when XStart = XStop + 1;
|
|
pragma Assert (XStart <= XStop);
|
|
|
|
Output_One_Xref : declare
|
|
R : SPARK_Xref_Record renames
|
|
SPARK_Xref_Table.Table (XStart);
|
|
|
|
begin
|
|
if R.Entity_Line /= Entity_Line
|
|
or else R.Entity_Col /= Entity_Col
|
|
then
|
|
Write_Info_Terminate;
|
|
|
|
Write_Info_Initiate ('F');
|
|
Write_Info_Char (' ');
|
|
Write_Info_Nat (R.Entity_Line);
|
|
Write_Info_Char (R.Etype);
|
|
Write_Info_Nat (R.Entity_Col);
|
|
Write_Info_Char (' ');
|
|
|
|
for N in R.Entity_Name'Range loop
|
|
Write_Info_Char (R.Entity_Name (N));
|
|
end loop;
|
|
|
|
Entity_Line := R.Entity_Line;
|
|
Entity_Col := R.Entity_Col;
|
|
File := F.File_Num;
|
|
Scope := S.Scope_Num;
|
|
end if;
|
|
|
|
if Write_Info_Col > 72 then
|
|
Write_Info_Terminate;
|
|
Write_Info_Initiate ('.');
|
|
end if;
|
|
|
|
Write_Info_Char (' ');
|
|
|
|
if R.File_Num /= File then
|
|
Write_Info_Nat (R.File_Num);
|
|
Write_Info_Char ('|');
|
|
File := R.File_Num;
|
|
Scope := 0;
|
|
end if;
|
|
|
|
if R.Scope_Num /= Scope then
|
|
Write_Info_Char ('.');
|
|
Write_Info_Nat (R.Scope_Num);
|
|
Write_Info_Char (':');
|
|
Scope := R.Scope_Num;
|
|
end if;
|
|
|
|
Write_Info_Nat (R.Line);
|
|
Write_Info_Char (R.Rtype);
|
|
Write_Info_Nat (R.Col);
|
|
end Output_One_Xref;
|
|
|
|
XStart := XStart + 1;
|
|
end loop;
|
|
|
|
Write_Info_Terminate;
|
|
end Output_One_Scope;
|
|
|
|
<<Continue>>
|
|
Start := Start + 1;
|
|
end loop;
|
|
end;
|
|
end loop;
|
|
end Put_SPARK_Xrefs;
|