161 lines
5.8 KiB
Ada
161 lines
5.8 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P U T _ S C O S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2009, 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 SCOs; use SCOs;
|
|
|
|
procedure Put_SCOs is
|
|
begin
|
|
-- Loop through entries in SCO_Unit_Table
|
|
|
|
for U in 1 .. SCO_Unit_Table.Last loop
|
|
declare
|
|
SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
|
|
|
|
Start : Nat;
|
|
Stop : Nat;
|
|
|
|
begin
|
|
Start := SUT.From;
|
|
Stop := SUT.To;
|
|
|
|
-- Write unit header (omitted if no SCOs are generated for this unit)
|
|
|
|
if Start <= Stop then
|
|
Write_Info_Initiate ('C');
|
|
Write_Info_Char (' ');
|
|
Write_Info_Nat (SUT.Dep_Num);
|
|
Write_Info_Char (' ');
|
|
|
|
for N in SUT.File_Name'Range loop
|
|
Write_Info_Char (SUT.File_Name (N));
|
|
end loop;
|
|
|
|
Write_Info_Terminate;
|
|
end if;
|
|
|
|
-- Loop through SCO entries for this unit
|
|
|
|
loop
|
|
exit when Start = Stop + 1;
|
|
pragma Assert (Start <= Stop);
|
|
|
|
Output_SCO_Line : declare
|
|
T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
|
|
|
procedure Output_Range (T : SCO_Table_Entry);
|
|
-- Outputs T.From and T.To in line:col-line:col format
|
|
|
|
------------------
|
|
-- Output_Range --
|
|
------------------
|
|
|
|
procedure Output_Range (T : SCO_Table_Entry) is
|
|
begin
|
|
Write_Info_Nat (Nat (T.From.Line));
|
|
Write_Info_Char (':');
|
|
Write_Info_Nat (Nat (T.From.Col));
|
|
Write_Info_Char ('-');
|
|
Write_Info_Nat (Nat (T.To.Line));
|
|
Write_Info_Char (':');
|
|
Write_Info_Nat (Nat (T.To.Col));
|
|
end Output_Range;
|
|
|
|
-- Start of processing for Output_SCO_Line
|
|
|
|
begin
|
|
Write_Info_Initiate ('C');
|
|
Write_Info_Char (T.C1);
|
|
|
|
case T.C1 is
|
|
|
|
-- Statements
|
|
|
|
when 'S' =>
|
|
loop
|
|
Write_Info_Char (' ');
|
|
|
|
if SCO_Table.Table (Start).C2 /= ' ' then
|
|
Write_Info_Char (SCO_Table.Table (Start).C2);
|
|
end if;
|
|
|
|
Output_Range (SCO_Table.Table (Start));
|
|
exit when SCO_Table.Table (Start).Last;
|
|
|
|
Start := Start + 1;
|
|
pragma Assert (SCO_Table.Table (Start).C1 = 's');
|
|
end loop;
|
|
|
|
-- Statement continuations should not occur since they
|
|
-- are supposed to have been handled in the loop above.
|
|
|
|
when 's' =>
|
|
raise Program_Error;
|
|
|
|
-- Decision
|
|
|
|
when 'I' | 'E' | 'P' | 'W' | 'X' =>
|
|
if T.C2 = ' ' then
|
|
Start := Start + 1;
|
|
end if;
|
|
|
|
-- Loop through table entries for this decision
|
|
|
|
loop
|
|
declare
|
|
T : SCO_Table_Entry renames SCO_Table.Table (Start);
|
|
|
|
begin
|
|
Write_Info_Char (' ');
|
|
|
|
if T.C1 = '!' or else
|
|
T.C1 = '^' or else
|
|
T.C1 = '&' or else
|
|
T.C1 = '|'
|
|
then
|
|
Write_Info_Char (T.C1);
|
|
|
|
else
|
|
Write_Info_Char (T.C2);
|
|
Output_Range (T);
|
|
end if;
|
|
|
|
exit when T.Last;
|
|
Start := Start + 1;
|
|
end;
|
|
end loop;
|
|
|
|
when others =>
|
|
raise Program_Error;
|
|
end case;
|
|
|
|
Write_Info_Terminate;
|
|
end Output_SCO_Line;
|
|
|
|
Start := Start + 1;
|
|
end loop;
|
|
end;
|
|
end loop;
|
|
end Put_SCOs;
|