Skip to content

R
riscv-gcc-1
Commit f7f0159d by Arnaud Charlet
Options

[multiple changes] 

2009-07-22  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi: Update doc for some gnatcheck rules.

2009-07-22  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, par_sco.ads (pscos): New debug routine to output
	contents of SCO tables.
	* put_scos.adb, put_scos.ads, get_scos.adb, get_scos.ads,
	scos.adb, scos.ads: New files.
	* gcc-interface/Make-lang.in: Update dependencies.

	* lib-util.ads, gnatbind.ads, ali.ads, binderr.ads: Minor comment
	fixes and reformatting.

From-SVN: r149943
parent a8338640
Showing with 700 additions and 28 deletions
gcc/ada/ChangeLog
2009-07-22 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update doc for some gnatcheck rules.
2009-07-22 Robert Dewar <dewar@adacore.com>
* par_sco.adb, par_sco.ads (pscos): New debug routine to output
contents of SCO tables.
* put_scos.adb, put_scos.ads, get_scos.adb, get_scos.ads,
scos.adb, scos.ads: New files.
* gcc-interface/Make-lang.in: Update dependencies.
* lib-util.ads, gnatbind.ads, ali.ads, binderr.ads: Minor comment
fixes and reformatting.
2009-07-22 Robert Dewar <dewar@adacore.com>
* g-socket.ads: Minor reformatting
......
gcc/ada/ali.ads
......@@ -42,9 +42,9 @@ package ALI is
-- Id Types --
--------------
-- The various entries are stored in tables with distinct subscript
-- ranges. The following type definitions indicate the ranges used
-- for the subscripts (Id values) for the various tables.
-- The various entries are stored in tables with distinct subscript ranges.
-- The following type definitions show the ranges used for the subscripts
-- (Id values) for the various tables.
type ALI_Id is range 0 .. 999_999;
-- Id values used for ALIs table entries
......@@ -103,8 +103,8 @@ package ALI is
-- V lines are ignored as a result of the Ignore_Lines parameter.
Ver_Len : Natural;
-- Length of characters stored in Ver. Not set if V lines are
-- ignored as a result of the Ignore_Lines parameter.
-- Length of characters stored in Ver. Not set if V lines are ignored as
-- a result of the Ignore_Lines parameter.
SAL_Interface : Boolean;
-- Set True when this is an interface to a standalone library
......
gcc/ada/binderr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......@@ -54,14 +54,14 @@ package Binderr is
-- Insertion character { (Left brace: insert file name from Names table)
-- The character { is replaced by the text for the file name specified
-- by the File_Name_Type value stored in Error_Msg_File_1. The name is
-- always enclosed in quotes. A second % may appear in a single message
-- always enclosed in quotes. A second { may appear in a single message
-- in which case it is similarly replaced by the name which is
-- specified by the File_Name_Type value stored in Error_Msg_File_2.
-- Insertion character $ (Dollar: insert unit name from Names table)
-- The character & is replaced by the text for the unit name specified
-- by the Name_Id value stored in Error_Msg_Unit_1. The name is always
-- enclosed in quotes. A second & may appear in a single message in
-- enclosed in quotes. A second $ may appear in a single message in
-- which case it is similarly replaced by the name which is specified
-- by the Name_Id value stored in Error_Msg_Unit_2.
......
gcc/ada/gcc-interface/Make-lang.in
......@@ -134,13 +134,16 @@ GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-exc
ada/g-hesora.o ada/g-htable.o ada/s-os_lib.o \
ada/g-speche.o ada/g-spchge.o ada/g-u3spch.o ada/s-string.o \
ada/s-utf_32.o ada/s-crc32.o ada/get_targ.o \
ada/get_scos.o \
ada/gnatvsn.o ada/hlo.o ada/hostparm.o ada/impunit.o ada/interfac.o \
ada/itypes.o ada/inline.o ada/krunch.o ada/lib.o ada/layout.o \
ada/lib-load.o ada/lib-util.o ada/lib-xref.o ada/lib-writ.o ada/live.o \
ada/namet.o ada/namet-sp.o \
ada/nlists.o ada/nmake.o ada/opt.o ada/osint.o ada/osint-c.o \
ada/output.o ada/par_sco.o \
ada/par.o ada/prep.o ada/prepcomp.o ada/repinfo.o ada/restrict.o \
ada/output.o \
ada/par_sco.o \
ada/par.o ada/prep.o ada/prepcomp.o ada/put_scos.o \
ada/repinfo.o ada/restrict.o \
ada/rident.o ada/rtsfind.o \
ada/s-addope.o ada/s-assert.o ada/s-parame.o ada/s-stache.o \
ada/s-stalib.o ada/s-imgenu.o ada/s-imenne.o ada/s-stoele.o ada/s-soflin.o \
......@@ -150,6 +153,7 @@ GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-exc
ada/s-conca2.o ada/s-conca3.o ada/s-conca4.o ada/s-conca5.o \
ada/s-conca6.o ada/s-conca7.o ada/s-conca8.o ada/s-conca9.o \
ada/s-unstyp.o ada/scans.o ada/scng.o ada/scn.o ada/sdefault.o ada/sem.o \
ada/scos.o \
ada/sem_aggr.o ada/sem_attr.o ada/sem_aux.o \
ada/sem_cat.o ada/sem_ch10.o ada/sem_ch11.o \
ada/sem_ch12.o ada/sem_ch13.o ada/sem_ch2.o ada/sem_ch3.o ada/sem_ch4.o \
......@@ -2272,6 +2276,12 @@ ada/g-u3spch.o : ada/gnat.ads ada/g-spchge.ads ada/g-spchge.adb \
ada/g-u3spch.ads ada/g-u3spch.adb ada/system.ads ada/s-wchcnv.ads \
ada/s-wchcon.ads
ada/get_scos.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
ada/get_scos.ads ada/get_scos.adb ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/scos.ads ada/system.ads ada/s-exctab.ads \
ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
ada/unchconv.ads ada/unchdeal.ads
ada/get_targ.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \
ada/get_targ.adb ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
......@@ -2671,18 +2681,19 @@ ada/par_sco.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/fname.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-hesorg.adb ada/g-htable.ads \
ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
ada/lib-sort.adb ada/lib-util.ads ada/lib-util.adb ada/namet.ads \
ada/nlists.ads ada/nlists.adb ada/opt.ads ada/osint.ads ada/osint-c.ads \
ada/output.ads ada/par_sco.ads ada/par_sco.adb ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-strhas.ads \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/widechar.ads
ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/lib.ads \
ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-util.ads \
ada/lib-util.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
ada/par_sco.ads ada/par_sco.adb ada/put_scos.ads ada/put_scos.adb \
ada/scos.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads \
ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/prep.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/csets.ads \
......@@ -2717,6 +2728,11 @@ ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/put_scos.ads ada/put_scos.adb ada/scos.ads \
ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/fname.ads \
......@@ -2963,6 +2979,11 @@ ada/scng.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \
ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \
ada/types.ads ada/unchconv.ads ada/unchdeal.ads
ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads \
ada/debug_a.ads ada/debug_a.adb ada/einfo.ads ada/einfo.adb \
......
gcc/ada/get_scos.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G E 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;
with Types; use Types;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
procedure Get_SCOs is
Dnum : Nat;
C : Character;
Loc1 : Source_Location;
Loc2 : Source_Location;
Cond : Character;
Dtyp : Character;
use ASCII;
-- For CR/LF
procedure Check (C : Character);
-- Checks that file is positioned at given character, and if so skips past
-- it, If not, raises Data_Error.
function Get_Int return Int;
-- On entry the file is positioned to a digit. On return, the file is
-- positioned past the last digit, and the returned result is the decimal
-- value read. Data_Error is raised for overflow (value greater than
-- Int'Last), or if the initial character is not a digit.
procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location);
-- Skips initial spaces, then reads a source location range in the form
-- line:col-line:col and places the two source locations in Loc1 and Loc2.
-- Raises Data_Error if format does not match this requirement.
procedure Skip_EOL;
-- Called with the current character about to be read being LF or CR. Skips
-- past LR/CR characters until either a non-CR/LF character is found, or
-- the end of file is encountered.
procedure Skip_Spaces;
-- Skips zero or more spaces at the current position, leaving the file
-- positioned at the first non-blank character (or Types.EOF).
-----------
-- Check --
-----------
procedure Check (C : Character) is
begin
if Nextc = C then
Skipc;
else
raise Data_Error;
end if;
end Check;
-------------
-- Get_Int --
-------------
function Get_Int return Int is
Val : Int;
C : Character;
begin
C := Nextc;
Val := 0;
if C not in '0' .. '9' then
raise Data_Error;
end if;
-- Loop to read digits of integer value
loop
declare
pragma Unsuppress (Overflow_Check);
begin
Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
end;
Skipc;
C := Nextc;
exit when C not in '0' .. '9';
end loop;
return Val;
exception
when Constraint_Error =>
raise Data_Error;
end Get_Int;
--------------------
-- Get_Sloc_Range --
--------------------
procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location) is
pragma Unsuppress (Range_Check);
begin
Skip_Spaces;
Loc1.Line := Logical_Line_Number (Get_Int);
Check (':');
Loc1.Col := Column_Number (Get_Int);
Check ('-');
Loc2.Line := Logical_Line_Number (Get_Int);
Check (':');
Loc2.Col := Column_Number (Get_Int);
exception
when Constraint_Error =>
raise Data_Error;
end Get_Sloc_Range;
--------------
-- Skip_EOL --
--------------
procedure Skip_EOL is
C : Character;
begin
loop
Skipc;
C := Getc;
exit when C /= LF and then C /= CR;
if C = ' ' then
Skip_Spaces;
exit when C /= LF and then C /= CR;
end if;
end loop;
end Skip_EOL;
-----------------
-- Skip_Spaces --
-----------------
procedure Skip_Spaces is
begin
while Nextc = ' ' loop
Skipc;
end loop;
end Skip_Spaces;
-- Start of processing for Get_Scos
begin
SCO_Table.Init;
SCO_Unit_Table.Init;
-- Loop through lines of SCO information
while Nextc = 'C' loop
Skipc;
C := Getc;
-- Make sure first line is a header line
if SCO_Unit_Table.Last = 0 and then C /= ' ' then
raise Data_Error;
end if;
-- Otherwise dispatch on type of line
case C is
-- Header entry
when ' ' =>
-- Complete previous entry if any
if SCO_Unit_Table.Last /= 0 then
SCO_Unit_Table.Table (SCO_Unit_Table.Last).To :=
SCO_Table.Last;
end if;
-- Scan out dependency number and file name
declare
Ptr : String_Ptr := new String (1 .. 32768);
N : Integer;
begin
Skip_Spaces;
Dnum := Get_Int;
Skip_Spaces;
N := 0;
while Nextc > ' ' loop
N := N + 1;
Ptr.all (N) := Getc;
end loop;
-- Make new unit table entry (will fill in To later)
SCO_Unit_Table.Append (
(File_Name => new String'(Ptr.all (1 .. N)),
Dep_Num => Dnum,
From => SCO_Table.Last + 1,
To => 0));
Free (Ptr);
end;
-- Statement entry
when 'S' =>
Get_Sloc_Range (Loc1, Loc2);
Add_SCO (C1 => 'S', From => Loc1, To => Loc2);
-- Exit entry
when 'T' =>
Get_Sloc_Range (Loc1, Loc2);
Add_SCO (C1 => 'T', From => Loc1, To => Loc2);
-- Decision entry
when 'I' | 'E' | 'W' | 'X' =>
Dtyp := C;
Skip_Spaces;
C := Getc;
-- Case of simple condition
if C = 'c' or else C = 't' or else C = 'f' then
Cond := C;
Get_Sloc_Range (Loc1, Loc2);
Add_SCO
(C1 => Dtyp,
C2 => Cond,
From => Loc1,
To => Loc2,
Last => True);
-- Complex expression
else
Add_SCO (C1 => Dtyp, Last => False);
-- Loop through terms in complex expression
while C /= CR and then C /= LF loop
if C = 'c' or else C = 't' or else C = 'f' then
Cond := C;
Get_Sloc_Range (Loc1, Loc2);
Add_SCO
(C2 => C,
From => Loc1,
To => Loc2,
Last => False);
elsif C = '!' or else
C = '^' or else
C = '&' or else
C = '|'
then
Add_SCO (C1 => C, Last => False);
else
raise Data_Error;
end if;
end loop;
-- Reset Last indication to True for last entry
SCO_Table.Table (SCO_Table.Last).Last := True;
end if;
when others =>
raise Data_Error;
end case;
Skip_EOL;
end loop;
-- Here with all SCO's stored, complete last SCO Unit table entry
SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last;
end Get_SCOs;
gcc/ada/get_scos.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G E T _ S C O S --
-- --
-- S p e c --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package contains the function used to read SCO information from an
-- ALI file and populate the tables defined in package SCOs with the result.
generic
-- These subprograms provide access to the ALI file. Locating, opening
-- and providing access to the ALI file is the callers' responsibility.
with function Getc return Character is <>;
-- Get next character, positioning the ALI file ready to read the
-- following character (equivalent to calling Skipc, then Nextc). If
-- the end of file is encountered, the value Types.EOF is returned.
with function Nextc return Character is <>;
-- Look at the next character, and return it, leaving the position of the
-- file unchanged, so that a subsequent call to Getc or Nextc will return
-- this same character. If the file is positioned at the end of file, then
-- Types.EOF is returned.
with procedure Skipc is <>;
-- Skip past the current character (which typically was read with Nextc),
-- and position to the next character, which will be returned by the next
-- call to Getc or Nextc.
procedure Get_SCOs;
-- Load SCO information from ALI file text format into internal SCO tables
-- (SCOs.SCO_Table and SCOs.SCO_Unit_Table). On entry the input file is
-- positioned to the initial 'C' of the first SCO line in the ALI file.
-- On return, the file is positioned either to the end of file, or to the
-- first character of the line following the SCO information (which will
-- never start with a 'C').
--
-- If a format error is detected in the input, then an exceptions is raised
-- (Ada.IO_Exceptions.Data_Error), with the file positioned to the error.
gcc/ada/gnatbind.ads
......@@ -4,9 +4,9 @@
-- --
-- G N A T B I N D --
-- --
-- B o d y --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......
gcc/ada/lib-util.ads
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......@@ -45,9 +45,9 @@ package Lib.Util is
-- if the host system needs a write for each line.
procedure Write_Info_Initiate (Key : Character);
-- Initiates write of new line to info file, the parameter is the
-- keyword character for the line. The caller is responsible for
-- writing the required blank after the key character.
-- Initiates write of new line to info file, the parameter is the keyword
-- character for the line. The caller is responsible for writing the
-- required blank after the key character if needed.
procedure Write_Info_Nat (N : Nat);
-- Adds image of N to Info_Buffer with no leading or trailing blanks
......
gcc/ada/par_sco.adb
......@@ -30,6 +30,7 @@ with Lib.Util; use Lib.Util;
with Nlists; use Nlists;
with Opt; use Opt;
with Output; use Output;
with Put_SCOs;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Table;
......@@ -549,6 +550,41 @@ package body Par_SCO is
Traverse (N);
end Process_Decisions;
-----------
-- pscos --
-----------
procedure pscos is
procedure Write_Info_Char (C : Character) renames Write_Char;
-- Write one character;
procedure Write_Info_Initiate (Key : Character) renames Write_Char;
-- Start new one and write one character;
procedure Write_Info_Nat (N : Nat);
-- Write value of N
procedure Write_Info_Terminate renames Write_Eol;
-- Terminate current line
--------------------
-- Write_Info_Nat --
--------------------
procedure Write_Info_Nat (N : Nat) is
begin
Write_Int (N);
end Write_Info_Nat;
procedure Debug_Put_SCOs is new Put_SCOs;
-- Start of processing for pscos
begin
Debug_Put_SCOs;
end pscos;
----------------
-- SCO_Output --
----------------
......
gcc/ada/par_sco.ads
......@@ -211,4 +211,7 @@ package Par_SCO is
-- unit U in the ALI file, as recorded by previous calls to SCO_Record,
-- possibly modified by calls to Set_SCO_Condition.
procedure pscos;
-- Debugging procedure to output contents of SCO binary tables in SCOs
end Par_SCO;
gcc/ada/put_scos.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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 SCO_Unit_Table.First .. SCO_Unit_Table.Last loop
declare
SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
Start : Nat;
Stop : Nat;
begin
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;
-- Loop through SCO entries for this unit
Start := SCO_Table.First;
Stop := SCO_Table.Last;
loop
declare
T : SCO_Table_Entry renames SCO_Table.Table (Start);
procedure Output_Range;
-- Outputs T.From and T.To in line:col-line:col format
procedure Output_Range 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;
begin
Write_Info_Initiate ('C');
Write_Info_Char (T.C1);
case T.C1 is
-- Statements, exit
when 'S' | 'T' =>
Write_Info_Char (' ');
Output_Range;
-- Decision
when 'I' | 'E' | '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;
end if;
exit when T.Last;
Start := Start + 1;
end;
end loop;
when others =>
raise Program_Error;
end case;
Write_Info_Terminate;
end;
exit when Start = Stop;
Start := Start + 1;
pragma Assert (Start <= Stop);
end loop;
end;
-- If not last entry, blank line
if U /= SCO_Unit_Table.Last then
Write_Info_Terminate;
end if;
end loop;
end Put_SCOs;
gcc/ada/put_scos.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P U T _ S C O S --
-- --
-- S p e c --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package contains the function used to read SCO information from the
-- internal tables defined in package SCOs, and output text information for
-- the ALI file. The interface allows control over the destination of the
-- output, so that this routine can also be used for debugging purposes.
with Types; use Types;
generic
-- The following procedures are used to output text information
with procedure Write_Info_Char (C : Character) is <>;
-- Outputs one character
with procedure Write_Info_Initiate (Key : Character) is <>;
-- Initiates write of new line to output file, the parameter is the
-- keyword character for the line.
with procedure Write_Info_Nat (N : Nat) is <>;
-- Writes image of N to output file with no leading or trailing blanks
with procedure Write_Info_Terminate is <>;
-- Terminate current info line and output lines built in Info_Buffer
procedure Put_SCOs;
-- Read information from SCOs.SCO_Table and SCOs.SCO_Unit_Table and output
-- corresponding information in ALI format using the Write_Info procedures.
gcc/ada/scos.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
package body SCOs is
procedure Add_SCO
(From : Source_Location := No_Location;
To : Source_Location := No_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Last : Boolean := False)
is
begin
SCO_Table.Append ((From, To, C1, C2, Last));
end Add_SCO;
end SCOs;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment