Skip to content

R
riscv-gcc-1
Commit 240fe2a4 by Arnaud Charlet
Options

[multiple changes] 

2009-07-22  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb (Gen_Loop): Do not qualify the bounds of the range if
	they are already of the base type of the index.

2009-07-22  Brett Porter  <porter@adacore.com>

	* sysdep.c, init.c: Fix typo: _SPE_ should have been __SPE__.

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

	* vms_data.ads: Add entry for SCO_OUTPUT (-gnateS)
	* gnat_ugn.texi: Add documentation for -gnateS switch
	* ug_words: Add entry for -gnateS /SCO_OUTPUT
	* gcc-interface/Make-lang.in: Update dependenciest.3

	* get_scos.adb, get_scos.ads, gnat1drv.adb, par_sco.adb,
	par_sco.ads, put_scos.adb, put_scos.ads, scos.adb, scos.ads: Initial
	complete information for SCO input/output.

From-SVN: r149945
parent f7f0159d
Showing with 333 additions and 299 deletions
gcc/ada/ChangeLog
2009-07-22 Eric Botcazou <ebotcazou@adacore.com>
* exp_aggr.adb (Gen_Loop): Do not qualify the bounds of the range if
they are already of the base type of the index.
2009-07-22 Brett Porter <porter@adacore.com>
* sysdep.c, init.c: Fix typo: _SPE_ should have been __SPE__.
2009-07-22 Robert Dewar <dewar@adacore.com>
* vms_data.ads: Add entry for SCO_OUTPUT (-gnateS)
* gnat_ugn.texi: Add documentation for -gnateS switch
* ug_words: Add entry for -gnateS /SCO_OUTPUT
* gcc-interface/Make-lang.in: Update dependenciest.3
* get_scos.adb, get_scos.ads, gnat1drv.adb, par_sco.adb,
par_sco.ads, put_scos.adb, put_scos.ads, scos.adb, scos.ads: Initial
complete information for SCO input/output.
2009-07-22 Sergey Rybin <rybin@adacore.com> 2009-07-22 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Update doc for some gnatcheck rules. * gnat_ugn.texi: Update doc for some gnatcheck rules.
......
gcc/ada/exp_aggr.adb
...@@ -1252,6 +1252,12 @@ package body Exp_Aggr is ...@@ -1252,6 +1252,12 @@ package body Exp_Aggr is
function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id is function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id is
L_J : Node_Id; L_J : Node_Id;
L_L : Node_Id;
-- Index_Base'(L)
L_H : Node_Id;
-- Index_Base'(H)
L_Range : Node_Id; L_Range : Node_Id;
-- Index_Base'(L) .. Index_Base'(H) -- Index_Base'(L) .. Index_Base'(H)
...@@ -1330,19 +1336,32 @@ package body Exp_Aggr is ...@@ -1330,19 +1336,32 @@ package body Exp_Aggr is
L_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J')); L_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
-- Construct "L .. H" -- Construct "L .. H" in Index_Base. We use a qualified expression
-- for the bound to convert to the index base, but we don't need
-- to do that if we already have the base type at hand.
L_Range := if Etype (L) = Index_Base then
Make_Range L_L := L;
(Loc, else
Low_Bound => Make_Qualified_Expression L_L :=
(Loc, Make_Qualified_Expression (Loc,
Subtype_Mark => Index_Base_Name, Subtype_Mark => Index_Base_Name,
Expression => L), Expression => L);
High_Bound => Make_Qualified_Expression end if;
(Loc,
if Etype (H) = Index_Base then
L_H := H;
else
L_H :=
Make_Qualified_Expression (Loc,
Subtype_Mark => Index_Base_Name, Subtype_Mark => Index_Base_Name,
Expression => H)); Expression => H);
end if;
L_Range :=
Make_Range (Loc,
Low_Bound => L_L,
High_Bound => L_H);
-- Construct "for L_J in Index_Base range L .. H" -- Construct "for L_J in Index_Base range L .. H"
......
gcc/ada/gcc-interface/Make-lang.in
...@@ -2295,30 +2295,30 @@ ada/gnat1drv.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -2295,30 +2295,30 @@ ada/gnat1drv.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \ ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
ada/erroutc.ads ada/exp_tss.ads ada/expander.ads ada/fmap.ads \ ada/erroutc.ads ada/exp_tss.ads ada/expander.ads ada/fmap.ads \
ada/fname.ads ada/fname-uf.ads ada/frontend.ads ada/get_targ.ads \ ada/fname.ads ada/fname-uf.ads ada/frontend.ads ada/get_targ.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnat1drv.ads \ ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/g-table.ads \
ada/gnat1drv.adb ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \ ada/g-table.adb ada/gnat1drv.ads ada/gnat1drv.adb ada/gnatvsn.ads \
ada/inline.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/lib.ads ada/lib.adb \
ada/lib-load.ads ada/lib-sort.adb ada/lib-writ.ads ada/lib-xref.ads \ ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-writ.ads \
ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \ ada/lib-xref.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
ada/osint.ads ada/output.ads ada/par_sco.ads ada/prepcomp.ads \ ada/nmake.ads ada/opt.ads ada/osint.ads ada/output.ads ada/par_sco.ads \
ada/repinfo.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \ ada/prepcomp.ads ada/repinfo.ads ada/restrict.ads ada/rident.ads \
ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_ch10.ads \ ada/rtsfind.ads ada/scos.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \ ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \
ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \ ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_elim.ads \ ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
ada/sem_eval.ads ada/sem_prag.ads ada/sem_type.ads ada/sem_util.ads \ ada/sem_elim.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_type.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \ ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/sinput-l.ads ada/snames.ads ada/sprint.ads ada/stand.ads \ ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/sprint.ads \
ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-assert.ads \ ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \ ada/s-assert.ads ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads \ ada/table.adb ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads \
ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads \ ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
ada/validsw.ads ada/widechar.ads ada/usage.ads ada/validsw.ads ada/widechar.ads
ada/gnatbind.o : ada/ada.ads ada/a-comlin.ads ada/a-clrefi.ads \ ada/gnatbind.o : ada/ada.ads ada/a-comlin.ads ada/a-clrefi.ads \
ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \ ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \
......
gcc/ada/get_scos.adb
...@@ -149,11 +149,12 @@ procedure Get_SCOs is ...@@ -149,11 +149,12 @@ procedure Get_SCOs is
begin begin
loop loop
Skipc; Skipc;
C := Getc; C := Nextc;
exit when C /= LF and then C /= CR; exit when C /= LF and then C /= CR;
if C = ' ' then if C = ' ' then
Skip_Spaces; Skip_Spaces;
C := Nextc;
exit when C /= LF and then C /= CR; exit when C /= LF and then C /= CR;
end if; end if;
end loop; end loop;
...@@ -173,8 +174,7 @@ procedure Get_SCOs is ...@@ -173,8 +174,7 @@ procedure Get_SCOs is
-- Start of processing for Get_Scos -- Start of processing for Get_Scos
begin begin
SCO_Table.Init; SCOs.Initialize;
SCO_Unit_Table.Init;
-- Loop through lines of SCO information -- Loop through lines of SCO information
...@@ -276,7 +276,7 @@ begin ...@@ -276,7 +276,7 @@ begin
Cond := C; Cond := C;
Get_Sloc_Range (Loc1, Loc2); Get_Sloc_Range (Loc1, Loc2);
Add_SCO Add_SCO
(C2 => C, (C2 => Cond,
From => Loc1, From => Loc1,
To => Loc2, To => Loc2,
Last => False); Last => False);
...@@ -288,9 +288,14 @@ begin ...@@ -288,9 +288,14 @@ begin
then then
Add_SCO (C1 => C, Last => False); Add_SCO (C1 => C, Last => False);
elsif C = ' ' then
Skip_Spaces;
else else
raise Data_Error; raise Data_Error;
end if; end if;
C := Getc;
end loop; end loop;
-- Reset Last indication to True for last entry -- Reset Last indication to True for last entry
......
gcc/ada/get_scos.ads
...@@ -23,17 +23,17 @@ ...@@ -23,17 +23,17 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package contains the function used to read SCO information from an -- This package contains the function used to read SCO information from an ALI
-- ALI file and populate the tables defined in package SCOs with the result. -- file and populate the tables defined in package SCOs with the result.
generic generic
-- These subprograms provide access to the ALI file. Locating, opening -- These subprograms provide access to the ALI file. Locating, opening and
-- and providing access to the ALI file is the callers' responsibility. -- providing access to the ALI file is the callers' responsibility.
with function Getc return Character is <>; with function Getc return Character is <>;
-- Get next character, positioning the ALI file ready to read the -- Get next character, positioning the ALI file ready to read the following
-- following character (equivalent to calling Skipc, then Nextc). If -- character (equivalent to calling Skipc, then Nextc). If the end of file
-- the end of file is encountered, the value Types.EOF is returned. -- is encountered, the value Types.EOF is returned.
with function Nextc return Character is <>; with function Nextc return Character is <>;
-- Look at the next character, and return it, leaving the position of the -- Look at the next character, and return it, leaving the position of the
......
gcc/ada/gnat1drv.adb
...@@ -50,6 +50,7 @@ with Prepcomp; ...@@ -50,6 +50,7 @@ with Prepcomp;
with Repinfo; use Repinfo; with Repinfo; use Repinfo;
with Restrict; with Restrict;
with Rtsfind; with Rtsfind;
with SCOs;
with Sem; with Sem;
with Sem_Ch8; with Sem_Ch8;
with Sem_Ch12; with Sem_Ch12;
...@@ -537,6 +538,7 @@ begin ...@@ -537,6 +538,7 @@ begin
Urealp.Initialize; Urealp.Initialize;
Errout.Initialize; Errout.Initialize;
Namet.Initialize; Namet.Initialize;
SCOs.Initialize;
Snames.Initialize; Snames.Initialize;
Stringt.Initialize; Stringt.Initialize;
Inline.Initialize; Inline.Initialize;
......
gcc/ada/gnat_ugn.texi
...@@ -4157,6 +4157,13 @@ Specify a preprocessing data file ...@@ -4157,6 +4157,13 @@ Specify a preprocessing data file
@end ifclear @end ifclear
(@pxref{Integrated Preprocessing}). (@pxref{Integrated Preprocessing}).
@item -gnateS
@cindex @option{-gnateS} (@command{gcc})
Generate SCO (Source Coverage Obligation) information in the ALI
file. This information is used by advanced coverage tools. See
unit @file{SCOs} in the compiler sources for details in files
@file{scos.ads} and @file{scos.adb}.
@item -gnatE @item -gnatE
@cindex @option{-gnatE} (@command{gcc}) @cindex @option{-gnatE} (@command{gcc})
Full dynamic elaboration checks. Full dynamic elaboration checks.
...@@ -21013,6 +21020,7 @@ used as a parameter of the @option{+R} or @option{-R} options. ...@@ -21013,6 +21020,7 @@ used as a parameter of the @option{+R} or @option{-R} options.
* Improperly_Called_Protected_Entries:: * Improperly_Called_Protected_Entries::
@end ignore @end ignore
* Metrics:: * Metrics::
* Misnamed_Controlling_Parameters::
* Misnamed_Identifiers:: * Misnamed_Identifiers::
* Multiple_Entries_In_Protected_Definitions:: * Multiple_Entries_In_Protected_Definitions::
* Name_Clashes:: * Name_Clashes::
...@@ -21798,6 +21806,25 @@ To turn OFF the check for cyclomatic complexity metric, use the following option ...@@ -21798,6 +21806,25 @@ To turn OFF the check for cyclomatic complexity metric, use the following option
-RMetrics_Cyclomatic_Complexity -RMetrics_Cyclomatic_Complexity
@end smallexample @end smallexample
@node Misnamed_Controlling_Parameters
@subsection @code{Misnamed_Controlling_Parameters}
@cindex @code{Misnamed_Controlling_Parameters} rule (for @command{gnatcheck})
@noindent
Flags a declaration of a dispatching operation, if the first parameter is
not a controlling one and its name is not @code{This} (the check for
parameter name is not case-sensitive). Declarations of dispatching functions
with controlling result and no controlling parameter are never flagged.
A subprogram body declaration, subprogram renaming declaration of subprogram
body stub is flagged only if it is not a completion of a pripr subprogram
declaration.
This rule has no parameters.
@node Misnamed_Identifiers @node Misnamed_Identifiers
@subsection @code{Misnamed_Identifiers} @subsection @code{Misnamed_Identifiers}
@cindex @code{Misnamed_Identifiers} rule (for @command{gnatcheck}) @cindex @code{Misnamed_Identifiers} rule (for @command{gnatcheck})
gcc/ada/init.c
...@@ -1932,7 +1932,7 @@ __gnat_init_float (void) ...@@ -1932,7 +1932,7 @@ __gnat_init_float (void)
overflow settings are an OS configuration issue. The instructions overflow settings are an OS configuration issue. The instructions
below have no effect. */ below have no effect. */
#if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS) #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS)
#if defined (_SPE_) #if defined (__SPE__)
{ {
const unsigned long spefscr_mask = 0xfffffff3; const unsigned long spefscr_mask = 0xfffffff3;
unsigned long spefscr; unsigned long spefscr;
......
gcc/ada/par_sco.adb
...@@ -27,10 +27,12 @@ with Atree; use Atree; ...@@ -27,10 +27,12 @@ with Atree; use Atree;
with Debug; use Debug; with Debug; use Debug;
with Lib; use Lib; with Lib; use Lib;
with Lib.Util; use Lib.Util; with Lib.Util; use Lib.Util;
with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with Put_SCOs; with Put_SCOs;
with SCOs; use SCOs;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Sinput; use Sinput; with Sinput; use Sinput;
with Table; with Table;
...@@ -40,99 +42,25 @@ with GNAT.Heap_Sort_G; ...@@ -40,99 +42,25 @@ with GNAT.Heap_Sort_G;
package body Par_SCO is package body Par_SCO is
--------------- -----------------------
-- SCO_Table -- -- Unit Number Table --
--------------- -----------------------
-- Internal table used to store recorded SCO values. Table is populated by
-- calls to SCO_Record, and entries may be modified by Set_SCO_Condition.
type SCO_Table_Entry is record
From : Source_Ptr;
To : Source_Ptr;
C1 : Character;
C2 : Character;
Last : Boolean;
end record;
package SCO_Table is new Table.Table (
Table_Component_Type => SCO_Table_Entry,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 500,
Table_Increment => 300,
Table_Name => "SCO_Table_Entry");
-- The SCO_Table_Entry values appear as follows:
-- Statements
-- C1 = 'S'
-- C2 = ' '
-- From = starting sloc
-- To = ending sloc
-- Last = unused
-- Exit
-- C1 = 'T'
-- C2 = ' '
-- From = starting sloc
-- To = ending sloc
-- Last = unused
-- Simple Decision
-- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
-- C2 = 'c', 't', or 'f'
-- From = starting sloc
-- To = ending sloc
-- Last = True
-- Complex Decision
-- C1 = 'I', 'E', 'W', 'X' (if/exit/while/expression)
-- C2 = ' '
-- From = No_Location
-- To = No_Location
-- Last = False
-- Operator
-- C1 = '!', '^', '&', '|'
-- C2 = ' '
-- From = No_Location
-- To = No_Location
-- Last = False
-- Element
-- C1 = ' '
-- C2 = 'c', 't', or 'f' (condition/true/false)
-- From = starting sloc
-- To = ending sloc
-- Last = False for all but the last entry, True for last entry
-- Note: the sequence starting with a decision, and continuing with
-- operators and elements up to and including the first one labeled with
-- Last=True, indicate the sequence to be output for a complex decision
-- on a single CD decision line.
----------------
-- Unit Table --
----------------
-- This table keeps track of the units and the corresponding starting and -- This table parallels the SCO_Unit_Table, keeping track of the unit
-- ending indexes (From, To) in the SCO table. Note that entry zero is -- numbers corresponding to the entries made in this table, so that before
-- unused, it is for convenience in calling the sort routine. -- writing out the SCO information to the ALI file, we can fill in the
-- proper dependency numbers and file names.
type SCO_Unit_Table_Entry is record -- Note that the zero'th entry is here for convenience in sorting the
Unit : Unit_Number_Type; -- table, the real lower bound is 1.
From : Nat;
To : Nat;
end record;
package SCO_Unit_Table is new Table.Table ( package SCO_Unit_Number_Table is new Table.Table (
Table_Component_Type => SCO_Unit_Table_Entry, Table_Component_Type => Unit_Number_Type,
Table_Index_Type => Int, Table_Index_Type => SCO_Unit_Index,
Table_Low_Bound => 0, Table_Low_Bound => 0, -- see note above on sort
Table_Initial => 20, Table_Initial => 20,
Table_Increment => 200, Table_Increment => 200,
Table_Name => "SCO_Unit_Table_Entry"); Table_Name => "SCO_Unit_Number_Entry");
-------------------------- --------------------------
-- Condition Hash Table -- -- Condition Hash Table --
...@@ -196,8 +124,8 @@ package body Par_SCO is ...@@ -196,8 +124,8 @@ package body Par_SCO is
procedure Traverse_Subprogram_Body (N : Node_Id); procedure Traverse_Subprogram_Body (N : Node_Id);
-- Traverse the corresponding construct, generating SCO table entries -- Traverse the corresponding construct, generating SCO table entries
procedure dsco; procedure Write_SCOs_To_ALI_File is new Put_SCOs;
-- Debug routine to dump SCO table -- Write SCO information to the ALI file using routines in Lib.Util
---------- ----------
-- dsco -- -- dsco --
...@@ -205,41 +133,92 @@ package body Par_SCO is ...@@ -205,41 +133,92 @@ package body Par_SCO is
procedure dsco is procedure dsco is
begin begin
-- Dump SCO unit table
Write_Line ("SCO Unit Table"); Write_Line ("SCO Unit Table");
Write_Line ("--------------"); Write_Line ("--------------");
for Index in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop for Index in 1 .. SCO_Unit_Table.Last loop
declare
UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);
begin
Write_Str (" "); Write_Str (" ");
Write_Int (Index); Write_Int (Int (Index));
Write_Str (". Unit = "); Write_Str (". Dep_Num = ");
Write_Int (Int (SCO_Unit_Table.Table (Index).Unit)); Write_Int (Int (UTE.Dep_Num));
Write_Str (" From = "); Write_Str (" From = ");
Write_Int (Int (SCO_Unit_Table.Table (Index).From)); Write_Int (Int (UTE.From));
Write_Str (" To = "); Write_Str (" To = ");
Write_Int (Int (SCO_Unit_Table.Table (Index).To)); Write_Int (Int (UTE.To));
Write_Str (" File_Name = """);
if UTE.File_Name /= null then
Write_Str (UTE.File_Name.all);
end if;
Write_Char ('"');
Write_Eol; Write_Eol;
end;
end loop; end loop;
-- Dump SCO Unit number table if it contains any entries
if SCO_Unit_Number_Table.Last >= 1 then
Write_Eol;
Write_Line ("SCO Unit Number Table");
Write_Line ("---------------------");
for Index in 1 .. SCO_Unit_Number_Table.Last loop
Write_Str (" ");
Write_Int (Int (Index));
Write_Str (". Unit_Number = ");
Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
Write_Eol;
end loop;
end if;
-- Dump SCO table itself
Write_Eol; Write_Eol;
Write_Line ("SCO Table"); Write_Line ("SCO Table");
Write_Line ("---------"); Write_Line ("---------");
for Index in SCO_Table.First .. SCO_Table.Last loop for Index in 1 .. SCO_Table.Last loop
declare declare
T : SCO_Table_Entry renames SCO_Table.Table (Index); T : SCO_Table_Entry renames SCO_Table.Table (Index);
begin begin
Write_Str (" "); Write_Str (" ");
Write_Int (Index); Write_Int (Index);
Write_Str (". C1 = '"); Write_Char ('.');
if T.C1 /= ' ' then
Write_Str (" C1 = '");
Write_Char (T.C1); Write_Char (T.C1);
Write_Str ("' C2 = '"); Write_Char (''');
end if;
if T.C2 /= ' ' then
Write_Str (" C2 = '");
Write_Char (T.C2); Write_Char (T.C2);
Write_Str ("' From = "); Write_Char (''');
Write_Location (T.From); end if;
if T.From /= No_Source_Location then
Write_Str (" From = ");
Write_Int (Int (T.From.Line));
Write_Char (':');
Write_Int (Int (T.From.Col));
end if;
if T.To /= No_Source_Location then
Write_Str (" To = "); Write_Str (" To = ");
Write_Location (T.To); Write_Int (Int (T.To.Line));
Write_Str (" Last = "); Write_Char (':');
Write_Int (Int (T.To.Col));
end if;
if T.Last then if T.Last then
Write_Str (" True"); Write_Str (" True");
...@@ -305,9 +284,11 @@ package body Par_SCO is ...@@ -305,9 +284,11 @@ package body Par_SCO is
procedure Initialize is procedure Initialize is
begin begin
SCO_Unit_Table.Init; SCO_Unit_Number_Table.Init;
SCO_Unit_Table.Increment_Last;
SCO_Table.Init; -- Set dummy 0'th entry in place for sort
SCO_Unit_Number_Table.Increment_Last;
end Initialize; end Initialize;
------------------------- -------------------------
...@@ -381,9 +362,6 @@ package body Par_SCO is ...@@ -381,9 +362,6 @@ package body Par_SCO is
C : Character; C : Character;
L : Node_Id; L : Node_Id;
FSloc : Source_Ptr;
LSloc : Source_Ptr;
begin begin
if No (N) then if No (N) then
return; return;
...@@ -407,8 +385,7 @@ package body Par_SCO is ...@@ -407,8 +385,7 @@ package body Par_SCO is
end if; end if;
end if; end if;
Sloc_Range (N, FSloc, LSloc); Set_Table_Entry (C, ' ', No_Location, No_Location, False);
Set_Table_Entry (C, ' ', FSloc, LSloc, False);
Output_Decision_Operand (L); Output_Decision_Operand (L);
Output_Decision_Operand (Right_Opnd (N)); Output_Decision_Operand (Right_Opnd (N));
...@@ -590,37 +567,12 @@ package body Par_SCO is ...@@ -590,37 +567,12 @@ package body Par_SCO is
---------------- ----------------
procedure SCO_Output is procedure SCO_Output is
Start : Nat;
Stop : Nat;
U : Unit_Number_Type;
procedure Output_Range (From : Source_Ptr; To : Source_Ptr);
-- Outputs Sloc range in line:col-line:col format (for now we do not
-- worry about generic instantiations???)
------------------
-- Output_Range --
------------------
procedure Output_Range (From : Source_Ptr; To : Source_Ptr) is
begin
Write_Info_Nat (Int (Get_Logical_Line_Number (From)));
Write_Info_Char (':');
Write_Info_Nat (Int (Get_Column_Number (From)));
Write_Info_Char ('-');
Write_Info_Nat (Int (Get_Logical_Line_Number (To)));
Write_Info_Char (':');
Write_Info_Nat (Int (Get_Column_Number (To)));
end Output_Range;
-- Start of processing for SCO_Output
begin begin
if Debug_Flag_Dot_OO then if Debug_Flag_Dot_OO then
dsco; dsco;
end if; end if;
-- Sort the unit table -- Sort the unit tables based on dependency numbers
Unit_Table_Sort : declare Unit_Table_Sort : declare
...@@ -636,8 +588,12 @@ package body Par_SCO is ...@@ -636,8 +588,12 @@ package body Par_SCO is
function Lt (Op1, Op2 : Natural) return Boolean is function Lt (Op1, Op2 : Natural) return Boolean is
begin begin
return Dependency_Num (SCO_Unit_Table.Table (Nat (Op1)).Unit) < return
Dependency_Num (SCO_Unit_Table.Table (Nat (Op2)).Unit); Dependency_Num
(SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
<
Dependency_Num
(SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
end Lt; end Lt;
---------- ----------
...@@ -646,8 +602,10 @@ package body Par_SCO is ...@@ -646,8 +602,10 @@ package body Par_SCO is
procedure Move (From : Natural; To : Natural) is procedure Move (From : Natural; To : Natural) is
begin begin
SCO_Unit_Table.Table (Nat (To)) := SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
SCO_Unit_Table.Table (Nat (From)); SCO_Unit_Table.Table (SCO_Unit_Index (From));
SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
end Move; end Move;
package Sorting is new GNAT.Heap_Sort_G (Move, Lt); package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
...@@ -658,88 +616,23 @@ package body Par_SCO is ...@@ -658,88 +616,23 @@ package body Par_SCO is
Sorting.Sort (Integer (SCO_Unit_Table.Last)); Sorting.Sort (Integer (SCO_Unit_Table.Last));
end Unit_Table_Sort; end Unit_Table_Sort;
-- Loop through entries in the unit table -- Loop through entries in the unit table to set file name and
-- dependency number entries.
for J in 1 .. SCO_Unit_Table.Last loop for J in 1 .. SCO_Unit_Table.Last loop
U := SCO_Unit_Table.Table (J).Unit;
-- Output header line preceded by blank line
Write_Info_Terminate;
Write_Info_Initiate ('C');
Write_Info_Char (' ');
Write_Info_Nat (Dependency_Num (U));
Write_Info_Char (' ');
Write_Info_Name (Reference_Name (Source_Index (U)));
Write_Info_Terminate;
Start := SCO_Unit_Table.Table (J).From;
Stop := SCO_Unit_Table.Table (J).To;
-- Loop through relevant entries in SCO table, outputting C lines
while Start <= Stop loop
declare declare
T : SCO_Table_Entry renames SCO_Table.Table (Start); U : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);
begin
Write_Info_Initiate ('C');
Write_Info_Char (T.C1);
case T.C1 is
-- Statements, exit
when 'S' | 'T' =>
Write_Info_Char (' ');
Output_Range (T.From, T.To);
-- 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 begin
Write_Info_Char (' '); Get_Name_String (Reference_Name (Source_Index (U)));
UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
if T.C1 = '!' or else UTE.Dep_Num := Dependency_Num (U);
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.From, T.To);
end if;
exit when T.Last;
Start := Start + 1;
end; end;
end loop; end loop;
when others => -- Now the tables are all setup for output to the ALI file
raise Program_Error;
end case;
Write_Info_Terminate;
end;
exit when Start = Stop;
Start := Start + 1;
pragma Assert (Start <= Stop); Write_SCOs_To_ALI_File;
end loop;
end loop;
end SCO_Output; end SCO_Output;
---------------- ----------------
...@@ -759,8 +652,8 @@ package body Par_SCO is ...@@ -759,8 +652,8 @@ package body Par_SCO is
-- Ignore call if this unit already recorded -- Ignore call if this unit already recorded
for J in 1 .. SCO_Unit_Table.Last loop for J in 1 .. SCO_Unit_Number_Table.Last loop
if SCO_Unit_Table.Table (J).Unit = U then if U = SCO_Unit_Number_Table.Table (J) then
return; return;
end if; end if;
end loop; end loop;
...@@ -799,9 +692,16 @@ package body Par_SCO is ...@@ -799,9 +692,16 @@ package body Par_SCO is
Process_Decisions (Lu, 'X'); Process_Decisions (Lu, 'X');
end if; end if;
-- Make entry for new unit in unit table -- Make entry for new unit in unit tables, we will fill in the file
-- name and dependency numbers later.
SCO_Unit_Table.Append (
(Dep_Num => 0,
File_Name => null,
From => From,
To => SCO_Table.Last));
SCO_Unit_Table.Append ((Unit => U, From => From, To => SCO_Table.Last)); SCO_Unit_Number_Table.Append (U);
end SCO_Record; end SCO_Record;
----------------------- -----------------------
...@@ -827,12 +727,33 @@ package body Par_SCO is ...@@ -827,12 +727,33 @@ package body Par_SCO is
To : Source_Ptr; To : Source_Ptr;
Last : Boolean) Last : Boolean)
is is
function To_Source_Location (S : Source_Ptr) return Source_Location;
-- Converts Source_Ptr value to Source_Location (line/col) format
------------------------
-- To_Source_Location --
------------------------
function To_Source_Location (S : Source_Ptr) return Source_Location is
begin begin
SCO_Table.Append ((C1 => C1, if S = No_Location then
return No_Source_Location;
else
return
(Line => Get_Logical_Line_Number (S),
Col => Get_Column_Number (S));
end if;
end To_Source_Location;
-- Start of processing for Set_Table_Entry
begin
Add_SCO
(C1 => C1,
C2 => C2, C2 => C2,
From => From, From => To_Source_Location (From),
To => To, To => To_Source_Location (To),
Last => Last)); Last => Last);
end Set_Table_Entry; end Set_Table_Entry;
----------------------------------------- -----------------------------------------
......
gcc/ada/par_sco.ads
...@@ -211,7 +211,12 @@ package Par_SCO is ...@@ -211,7 +211,12 @@ package Par_SCO is
-- unit U in the ALI file, as recorded by previous calls to SCO_Record, -- unit U in the ALI file, as recorded by previous calls to SCO_Record,
-- possibly modified by calls to Set_SCO_Condition. -- possibly modified by calls to Set_SCO_Condition.
procedure dsco;
-- Debug routine to dump SCO table. This is a raw format dump showing
-- exactly what the tables contain.
procedure pscos; procedure pscos;
-- Debugging procedure to output contents of SCO binary tables in SCOs -- Debugging procedure to output contents of SCO binary tables in the
-- format in which they appear in an ALI file.
end Par_SCO; end Par_SCO;
gcc/ada/put_scos.adb
...@@ -29,7 +29,7 @@ procedure Put_SCOs is ...@@ -29,7 +29,7 @@ procedure Put_SCOs is
begin begin
-- Loop through entries in SCO_Unit_Table -- Loop through entries in SCO_Unit_Table
for U in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop for U in 1 .. SCO_Unit_Table.Last loop
declare declare
SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U); SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
...@@ -50,16 +50,23 @@ begin ...@@ -50,16 +50,23 @@ begin
-- Loop through SCO entries for this unit -- Loop through SCO entries for this unit
Start := SCO_Table.First; Start := SUT.From;
Stop := SCO_Table.Last; Stop := SUT.To;
loop loop
declare exit when Start = Stop + 1;
pragma Assert (Start <= Stop);
Output_SCO_Line : declare
T : SCO_Table_Entry renames SCO_Table.Table (Start); T : SCO_Table_Entry renames SCO_Table.Table (Start);
procedure Output_Range; procedure Output_Range (T : SCO_Table_Entry);
-- Outputs T.From and T.To in line:col-line:col format -- Outputs T.From and T.To in line:col-line:col format
procedure Output_Range is ------------------
-- Output_Range --
------------------
procedure Output_Range (T : SCO_Table_Entry) is
begin begin
Write_Info_Nat (Nat (T.From.Line)); Write_Info_Nat (Nat (T.From.Line));
Write_Info_Char (':'); Write_Info_Char (':');
...@@ -70,6 +77,8 @@ begin ...@@ -70,6 +77,8 @@ begin
Write_Info_Nat (Nat (T.To.Col)); Write_Info_Nat (Nat (T.To.Col));
end Output_Range; end Output_Range;
-- Start of processing for Output_SCO_Line
begin begin
Write_Info_Initiate ('C'); Write_Info_Initiate ('C');
Write_Info_Char (T.C1); Write_Info_Char (T.C1);
...@@ -80,7 +89,7 @@ begin ...@@ -80,7 +89,7 @@ begin
when 'S' | 'T' => when 'S' | 'T' =>
Write_Info_Char (' '); Write_Info_Char (' ');
Output_Range; Output_Range (T);
-- Decision -- Decision
...@@ -107,7 +116,7 @@ begin ...@@ -107,7 +116,7 @@ begin
else else
Write_Info_Char (T.C2); Write_Info_Char (T.C2);
Output_Range; Output_Range (T);
end if; end if;
exit when T.Last; exit when T.Last;
...@@ -120,19 +129,10 @@ begin ...@@ -120,19 +129,10 @@ begin
end case; end case;
Write_Info_Terminate; Write_Info_Terminate;
end; end Output_SCO_Line;
exit when Start = Stop;
Start := Start + 1; Start := Start + 1;
pragma Assert (Start <= Stop);
end loop; end loop;
end; end;
-- If not last entry, blank line
if U /= SCO_Unit_Table.Last then
Write_Info_Terminate;
end if;
end loop; end loop;
end Put_SCOs; end Put_SCOs;
gcc/ada/put_scos.ads
...@@ -31,7 +31,10 @@ ...@@ -31,7 +31,10 @@
with Types; use Types; with Types; use Types;
generic generic
-- The following procedures are used to output text information -- The following procedures are used to output text information. The
-- destination of the text information is thus under control of the
-- particular instantiation. In particular, this procedure is used to
-- write output to the ALI file, and also for debugging output.
with procedure Write_Info_Char (C : Character) is <>; with procedure Write_Info_Char (C : Character) is <>;
-- Outputs one character -- Outputs one character
......
gcc/ada/scos.adb
...@@ -25,9 +25,13 @@ ...@@ -25,9 +25,13 @@
package body SCOs is package body SCOs is
-------------
-- Add_SCO --
-------------
procedure Add_SCO procedure Add_SCO
(From : Source_Location := No_Location; (From : Source_Location := No_Source_Location;
To : Source_Location := No_Location; To : Source_Location := No_Source_Location;
C1 : Character := ' '; C1 : Character := ' ';
C2 : Character := ' '; C2 : Character := ' ';
Last : Boolean := False) Last : Boolean := False)
...@@ -36,4 +40,18 @@ package body SCOs is ...@@ -36,4 +40,18 @@ package body SCOs is
SCO_Table.Append ((From, To, C1, C2, Last)); SCO_Table.Append ((From, To, C1, C2, Last));
end Add_SCO; end Add_SCO;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
SCO_Table.Init;
SCO_Unit_Table.Init;
-- Set dummy zeroth entry for sort routine, real entries start at 1
SCO_Unit_Table.Increment_Last;
end Initialize;
end SCOs; end SCOs;
gcc/ada/scos.ads
...@@ -210,7 +210,7 @@ package SCOs is ...@@ -210,7 +210,7 @@ package SCOs is
Col : Column_Number; Col : Column_Number;
end record; end record;
No_Location : Source_Location := (No_Line_Number, No_Column_Number); No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
type SCO_Table_Entry is record type SCO_Table_Entry is record
From : Source_Location; From : Source_Location;
...@@ -282,9 +282,8 @@ package SCOs is ...@@ -282,9 +282,8 @@ package SCOs is
-- This table keeps track of the units and the corresponding starting and -- This table keeps track of the units and the corresponding starting and
-- ending indexes (From, To) in the SCO table. Note that entry zero is -- ending indexes (From, To) in the SCO table. Note that entry zero is
-- unused, it is for convenience in calling the sort routine. The Info -- unused, it is for convenience in calling the sort routine. Thus the
-- field is an identifier supplied when an entry is built (e.g. in the -- real lower bound for active entries is 1.
-- compiler this is the Unit_Number_Type value.
type SCO_Unit_Index is new Int; type SCO_Unit_Index is new Int;
-- Used to index values in this table. Values start at 1 and are assigned -- Used to index values in this table. Values start at 1 and are assigned
...@@ -307,7 +306,7 @@ package SCOs is ...@@ -307,7 +306,7 @@ package SCOs is
package SCO_Unit_Table is new GNAT.Table ( package SCO_Unit_Table is new GNAT.Table (
Table_Component_Type => SCO_Unit_Table_Entry, Table_Component_Type => SCO_Unit_Table_Entry,
Table_Index_Type => SCO_Unit_Index, Table_Index_Type => SCO_Unit_Index,
Table_Low_Bound => 0, Table_Low_Bound => 0, -- see note above on sorting
Table_Initial => 20, Table_Initial => 20,
Table_Increment => 200); Table_Increment => 200);
...@@ -315,9 +314,12 @@ package SCOs is ...@@ -315,9 +314,12 @@ package SCOs is
-- Subprograms -- -- Subprograms --
----------------- -----------------
procedure Initialize;
-- Reset tables for a new compilation
procedure Add_SCO procedure Add_SCO
(From : Source_Location := No_Location; (From : Source_Location := No_Source_Location;
To : Source_Location := No_Location; To : Source_Location := No_Source_Location;
C1 : Character := ' '; C1 : Character := ' ';
C2 : Character := ' '; C2 : Character := ' ';
Last : Boolean := False); Last : Boolean := False);
......
gcc/ada/sysdep.c
...@@ -954,7 +954,7 @@ __gnat_get_task_options (void) ...@@ -954,7 +954,7 @@ __gnat_get_task_options (void)
/* Force VX_FP_TASK because it is almost always required */ /* Force VX_FP_TASK because it is almost always required */
options |= VX_FP_TASK; options |= VX_FP_TASK;
#if defined (_SPE_) #if defined (__SPE__)
options |= VX_SPE_TASK; options |= VX_SPE_TASK;
#endif #endif
......
gcc/ada/ug_words
...@@ -66,6 +66,7 @@ gcc -c ^ GNAT COMPILE ...@@ -66,6 +66,7 @@ gcc -c ^ GNAT COMPILE
-gnateG ^ /GENERATE_PROCESSED_SOURCE -gnateG ^ /GENERATE_PROCESSED_SOURCE
-gnatem ^ /MAPPING_FILE -gnatem ^ /MAPPING_FILE
-gnatep ^ /DATA_PREPROCESSING -gnatep ^ /DATA_PREPROCESSING
-gnateS ^ /SCO_OUTPUT
-gnatE ^ /CHECKS=ELABORATION -gnatE ^ /CHECKS=ELABORATION
-gnatf ^ /REPORT_ERRORS=FULL -gnatf ^ /REPORT_ERRORS=FULL
-gnatF ^ /UPPERCASE_EXTERNALS -gnatF ^ /UPPERCASE_EXTERNALS
......
gcc/ada/vms_data.ads
...@@ -2183,6 +2183,16 @@ package VMS_Data is ...@@ -2183,6 +2183,16 @@ package VMS_Data is
-- --
-- Build against an alternate runtime system named xxx or RTS-xxx. -- Build against an alternate runtime system named xxx or RTS-xxx.
S_GCC_SCO : aliased constant S := "/SCO_OUTPUT " &
"-gnateS";
-- /NOSCO_OUTPUT (D)
-- /SCO_OUTPUT
--
-- Controls the output of SCO (Source Coverage Obligation) information
-- in the generated ALI file. This information is used by advanced source
-- coverage tools. For a full description of the SCO format, see unit
-- SCOs in the compiler sources (sco.ads/sco.adb).
S_GCC_Search : aliased constant S := "/SEARCH=*" & S_GCC_Search : aliased constant S := "/SEARCH=*" &
"-I*"; "-I*";
-- /SEARCH=(directory[,...]) -- /SEARCH=(directory[,...])
...@@ -3474,6 +3484,7 @@ package VMS_Data is ...@@ -3474,6 +3484,7 @@ package VMS_Data is
S_GCC_Repinfo 'Access, S_GCC_Repinfo 'Access,
S_GCC_RepinfX 'Access, S_GCC_RepinfX 'Access,
S_GCC_RTS 'Access, S_GCC_RTS 'Access,
S_GCC_SCO 'Access,
S_GCC_Search 'Access, S_GCC_Search 'Access,
S_GCC_Style 'Access, S_GCC_Style 'Access,
S_GCC_StyleX 'Access, S_GCC_StyleX 'Access,
......
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