From 240fe2a4ac0ed2c262365e8c13d7bc934fb5fc19 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 22 Jul 2009 17:56:47 +0200 Subject: [multiple changes] 2009-07-22 Eric Botcazou * 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 * sysdep.c, init.c: Fix typo: _SPE_ should have been __SPE__. 2009-07-22 Robert Dewar * 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 --- gcc/ada/ChangeLog | 20 ++ gcc/ada/exp_aggr.adb | 41 +++- gcc/ada/gcc-interface/Make-lang.in | 48 ++--- gcc/ada/get_scos.adb | 13 +- gcc/ada/get_scos.ads | 14 +- gcc/ada/gnat1drv.adb | 2 + gcc/ada/gnat_ugn.texi | 27 +++ gcc/ada/init.c | 2 +- gcc/ada/par_sco.adb | 399 +++++++++++++++---------------------- gcc/ada/par_sco.ads | 7 +- gcc/ada/put_scos.adb | 36 ++-- gcc/ada/put_scos.ads | 5 +- gcc/ada/scos.adb | 22 +- gcc/ada/scos.ads | 16 +- gcc/ada/sysdep.c | 2 +- gcc/ada/ug_words | 1 + gcc/ada/vms_data.ads | 11 + 17 files changed, 350 insertions(+), 316 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b5b2d56..4f26101 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2009-07-22 Eric Botcazou + + * 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 + + * sysdep.c, init.c: Fix typo: _SPE_ should have been __SPE__. + +2009-07-22 Robert Dewar + + * 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 * gnat_ugn.texi: Update doc for some gnatcheck rules. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index dfb164b..15338e4 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1252,6 +1252,12 @@ package body Exp_Aggr is function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id is L_J : Node_Id; + L_L : Node_Id; + -- Index_Base'(L) + + L_H : Node_Id; + -- Index_Base'(H) + L_Range : Node_Id; -- Index_Base'(L) .. Index_Base'(H) @@ -1330,19 +1336,32 @@ package body Exp_Aggr is 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. + + if Etype (L) = Index_Base then + L_L := L; + else + L_L := + Make_Qualified_Expression (Loc, + Subtype_Mark => Index_Base_Name, + Expression => L); + end if; + + if Etype (H) = Index_Base then + L_H := H; + else + L_H := + Make_Qualified_Expression (Loc, + Subtype_Mark => Index_Base_Name, + Expression => H); + end if; L_Range := - Make_Range - (Loc, - Low_Bound => Make_Qualified_Expression - (Loc, - Subtype_Mark => Index_Base_Name, - Expression => L), - High_Bound => Make_Qualified_Expression - (Loc, - Subtype_Mark => Index_Base_Name, - Expression => H)); + Make_Range (Loc, + Low_Bound => L_L, + High_Bound => L_H); -- Construct "for L_J in Index_Base range L .. H" diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index bea5d73..9a28ea3 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/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 \ 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/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/gnat1drv.adb ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \ - ada/inline.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \ - ada/lib-load.ads ada/lib-sort.adb ada/lib-writ.ads ada/lib-xref.ads \ - ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \ - ada/osint.ads ada/output.ads ada/par_sco.ads ada/prepcomp.ads \ - ada/repinfo.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \ - ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_ch10.ads \ - ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads \ - ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \ - ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_elim.ads \ - ada/sem_eval.ads ada/sem_prag.ads ada/sem_type.ads ada/sem_util.ads \ - ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \ - ada/sinput-l.ads ada/snames.ads ada/sprint.ads ada/stand.ads \ - ada/stringt.ads ada/stylesw.ads ada/system.ads ada/s-assert.ads \ - ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \ - ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ - ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ - ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ - ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ - ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads \ - ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \ - ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads \ - ada/validsw.ads ada/widechar.ads + ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/g-table.ads \ + ada/g-table.adb ada/gnat1drv.ads ada/gnat1drv.adb ada/gnatvsn.ads \ + ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/lib.ads ada/lib.adb \ + ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-writ.ads \ + ada/lib-xref.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \ + ada/nmake.ads ada/opt.ads ada/osint.ads ada/output.ads ada/par_sco.ads \ + ada/prepcomp.ads ada/repinfo.ads ada/restrict.ads ada/rident.ads \ + ada/rtsfind.ads ada/scos.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \ + ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \ + ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \ + ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \ + ada/sem_elim.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_type.ads \ + ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \ + ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/sprint.ads \ + ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \ + ada/s-assert.ads ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads \ + ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ + ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \ + ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \ + ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \ + ada/table.adb ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads \ + ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \ + ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.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/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \ diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index 185d80a..14d4256 100644 --- a/gcc/ada/get_scos.adb +++ b/gcc/ada/get_scos.adb @@ -149,11 +149,12 @@ procedure Get_SCOs is begin loop Skipc; - C := Getc; + C := Nextc; exit when C /= LF and then C /= CR; if C = ' ' then Skip_Spaces; + C := Nextc; exit when C /= LF and then C /= CR; end if; end loop; @@ -173,8 +174,7 @@ procedure Get_SCOs is -- Start of processing for Get_Scos begin - SCO_Table.Init; - SCO_Unit_Table.Init; + SCOs.Initialize; -- Loop through lines of SCO information @@ -276,7 +276,7 @@ begin Cond := C; Get_Sloc_Range (Loc1, Loc2); Add_SCO - (C2 => C, + (C2 => Cond, From => Loc1, To => Loc2, Last => False); @@ -288,9 +288,14 @@ begin then Add_SCO (C1 => C, Last => False); + elsif C = ' ' then + Skip_Spaces; + else raise Data_Error; end if; + + C := Getc; end loop; -- Reset Last indication to True for last entry diff --git a/gcc/ada/get_scos.ads b/gcc/ada/get_scos.ads index 0ece1ab..639d938 100644 --- a/gcc/ada/get_scos.ads +++ b/gcc/ada/get_scos.ads @@ -23,17 +23,17 @@ -- -- ------------------------------------------------------------------------------ --- 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. +-- 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. + -- 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. + -- 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 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 88a2530..199e3ff 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -50,6 +50,7 @@ with Prepcomp; with Repinfo; use Repinfo; with Restrict; with Rtsfind; +with SCOs; with Sem; with Sem_Ch8; with Sem_Ch12; @@ -537,6 +538,7 @@ begin Urealp.Initialize; Errout.Initialize; Namet.Initialize; + SCOs.Initialize; Snames.Initialize; Stringt.Initialize; Inline.Initialize; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index ad202ca..7b1d308 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4157,6 +4157,13 @@ Specify a preprocessing data file @end ifclear (@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 @cindex @option{-gnatE} (@command{gcc}) Full dynamic elaboration checks. @@ -21013,6 +21020,7 @@ used as a parameter of the @option{+R} or @option{-R} options. * Improperly_Called_Protected_Entries:: @end ignore * Metrics:: +* Misnamed_Controlling_Parameters:: * Misnamed_Identifiers:: * Multiple_Entries_In_Protected_Definitions:: * Name_Clashes:: @@ -21798,6 +21806,25 @@ To turn OFF the check for cyclomatic complexity metric, use the following option -RMetrics_Cyclomatic_Complexity @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 @subsection @code{Misnamed_Identifiers} @cindex @code{Misnamed_Identifiers} rule (for @command{gnatcheck}) diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 2f10505..ffea0e6 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -1932,7 +1932,7 @@ __gnat_init_float (void) overflow settings are an OS configuration issue. The instructions below have no effect. */ #if defined (_ARCH_PPC) && !defined (_SOFT_FLOAT) && !defined (VTHREADS) -#if defined (_SPE_) +#if defined (__SPE__) { const unsigned long spefscr_mask = 0xfffffff3; unsigned long spefscr; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 5bda78e..ea77263 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -27,10 +27,12 @@ with Atree; use Atree; with Debug; use Debug; with Lib; use Lib; with Lib.Util; use Lib.Util; +with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; with Output; use Output; with Put_SCOs; +with SCOs; use SCOs; with Sinfo; use Sinfo; with Sinput; use Sinput; with Table; @@ -40,99 +42,25 @@ with GNAT.Heap_Sort_G; package body Par_SCO is - --------------- - -- SCO_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 -- - ---------------- + ----------------------- + -- Unit Number Table -- + ----------------------- - -- 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 - -- unused, it is for convenience in calling the sort routine. + -- This table parallels the SCO_Unit_Table, keeping track of the unit + -- numbers corresponding to the entries made in this table, so that before + -- 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 - Unit : Unit_Number_Type; - From : Nat; - To : Nat; - end record; + -- Note that the zero'th entry is here for convenience in sorting the + -- table, the real lower bound is 1. - package SCO_Unit_Table is new Table.Table ( - Table_Component_Type => SCO_Unit_Table_Entry, - Table_Index_Type => Int, - Table_Low_Bound => 0, + package SCO_Unit_Number_Table is new Table.Table ( + Table_Component_Type => Unit_Number_Type, + Table_Index_Type => SCO_Unit_Index, + Table_Low_Bound => 0, -- see note above on sort Table_Initial => 20, Table_Increment => 200, - Table_Name => "SCO_Unit_Table_Entry"); + Table_Name => "SCO_Unit_Number_Entry"); -------------------------- -- Condition Hash Table -- @@ -196,8 +124,8 @@ package body Par_SCO is procedure Traverse_Subprogram_Body (N : Node_Id); -- Traverse the corresponding construct, generating SCO table entries - procedure dsco; - -- Debug routine to dump SCO table + procedure Write_SCOs_To_ALI_File is new Put_SCOs; + -- Write SCO information to the ALI file using routines in Lib.Util ---------- -- dsco -- @@ -205,46 +133,97 @@ package body Par_SCO is procedure dsco is begin + -- Dump SCO unit table + Write_Line ("SCO Unit Table"); Write_Line ("--------------"); - for Index in SCO_Unit_Table.First .. SCO_Unit_Table.Last loop - Write_Str (" "); - Write_Int (Index); - Write_Str (". Unit = "); - Write_Int (Int (SCO_Unit_Table.Table (Index).Unit)); - Write_Str (" From = "); - Write_Int (Int (SCO_Unit_Table.Table (Index).From)); - Write_Str (" To = "); - Write_Int (Int (SCO_Unit_Table.Table (Index).To)); - Write_Eol; + 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_Int (Int (Index)); + Write_Str (". Dep_Num = "); + Write_Int (Int (UTE.Dep_Num)); + Write_Str (" From = "); + Write_Int (Int (UTE.From)); + Write_Str (" 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; + end; 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_Line ("SCO Table"); Write_Line ("---------"); - for Index in SCO_Table.First .. SCO_Table.Last loop + for Index in 1 .. SCO_Table.Last loop declare T : SCO_Table_Entry renames SCO_Table.Table (Index); begin - Write_Str (" "); - Write_Int (Index); - Write_Str (". C1 = '"); - Write_Char (T.C1); - Write_Str ("' C2 = '"); - Write_Char (T.C2); - Write_Str ("' From = "); - Write_Location (T.From); - Write_Str (" To = "); - Write_Location (T.To); - Write_Str (" Last = "); + Write_Str (" "); + Write_Int (Index); + Write_Char ('.'); + + if T.C1 /= ' ' then + Write_Str (" C1 = '"); + Write_Char (T.C1); + Write_Char ('''); + end if; + + if T.C2 /= ' ' then + Write_Str (" C2 = '"); + Write_Char (T.C2); + Write_Char ('''); + 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_Int (Int (T.To.Line)); + Write_Char (':'); + Write_Int (Int (T.To.Col)); + end if; if T.Last then - Write_Str (" True"); + Write_Str (" True"); else - Write_Str (" False"); + Write_Str (" False"); end if; Write_Eol; @@ -305,9 +284,11 @@ package body Par_SCO is procedure Initialize is begin - SCO_Unit_Table.Init; - SCO_Unit_Table.Increment_Last; - SCO_Table.Init; + SCO_Unit_Number_Table.Init; + + -- Set dummy 0'th entry in place for sort + + SCO_Unit_Number_Table.Increment_Last; end Initialize; ------------------------- @@ -381,9 +362,6 @@ package body Par_SCO is C : Character; L : Node_Id; - FSloc : Source_Ptr; - LSloc : Source_Ptr; - begin if No (N) then return; @@ -407,8 +385,7 @@ package body Par_SCO is end if; end if; - Sloc_Range (N, FSloc, LSloc); - Set_Table_Entry (C, ' ', FSloc, LSloc, False); + Set_Table_Entry (C, ' ', No_Location, No_Location, False); Output_Decision_Operand (L); Output_Decision_Operand (Right_Opnd (N)); @@ -590,37 +567,12 @@ package body Par_SCO 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 if Debug_Flag_Dot_OO then dsco; end if; - -- Sort the unit table + -- Sort the unit tables based on dependency numbers Unit_Table_Sort : declare @@ -636,8 +588,12 @@ package body Par_SCO is function Lt (Op1, Op2 : Natural) return Boolean is begin - return Dependency_Num (SCO_Unit_Table.Table (Nat (Op1)).Unit) < - Dependency_Num (SCO_Unit_Table.Table (Nat (Op2)).Unit); + return + Dependency_Num + (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1))) + < + Dependency_Num + (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2))); end Lt; ---------- @@ -646,8 +602,10 @@ package body Par_SCO is procedure Move (From : Natural; To : Natural) is begin - SCO_Unit_Table.Table (Nat (To)) := - SCO_Unit_Table.Table (Nat (From)); + SCO_Unit_Table.Table (SCO_Unit_Index (To)) := + 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; package Sorting is new GNAT.Heap_Sort_G (Move, Lt); @@ -658,88 +616,23 @@ package body Par_SCO is Sorting.Sort (Integer (SCO_Unit_Table.Last)); 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 - 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 - T : SCO_Table_Entry renames SCO_Table.Table (Start); - - 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 - 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.From, T.To); - end if; - - exit when T.Last; - Start := Start + 1; - end; - end loop; - - when others => - raise Program_Error; - end case; - - Write_Info_Terminate; - end; + declare + U : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J); + UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J); + begin + Get_Name_String (Reference_Name (Source_Index (U))); + UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len)); + UTE.Dep_Num := Dependency_Num (U); + end; + end loop; - exit when Start = Stop; - Start := Start + 1; + -- Now the tables are all setup for output to the ALI file - pragma Assert (Start <= Stop); - end loop; - end loop; + Write_SCOs_To_ALI_File; end SCO_Output; ---------------- @@ -759,8 +652,8 @@ package body Par_SCO is -- Ignore call if this unit already recorded - for J in 1 .. SCO_Unit_Table.Last loop - if SCO_Unit_Table.Table (J).Unit = U then + for J in 1 .. SCO_Unit_Number_Table.Last loop + if U = SCO_Unit_Number_Table.Table (J) then return; end if; end loop; @@ -799,9 +692,16 @@ package body Par_SCO is Process_Decisions (Lu, 'X'); 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 ((Unit => U, From => From, To => SCO_Table.Last)); + SCO_Unit_Table.Append ( + (Dep_Num => 0, + File_Name => null, + From => From, + To => SCO_Table.Last)); + + SCO_Unit_Number_Table.Append (U); end SCO_Record; ----------------------- @@ -827,12 +727,33 @@ package body Par_SCO is To : Source_Ptr; Last : Boolean) 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 + 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 - SCO_Table.Append ((C1 => C1, - C2 => C2, - From => From, - To => To, - Last => Last)); + Add_SCO + (C1 => C1, + C2 => C2, + From => To_Source_Location (From), + To => To_Source_Location (To), + Last => Last); end Set_Table_Entry; ----------------------------------------- diff --git a/gcc/ada/par_sco.ads b/gcc/ada/par_sco.ads index 9f24af4..31ed2d8 100644 --- a/gcc/ada/par_sco.ads +++ b/gcc/ada/par_sco.ads @@ -211,7 +211,12 @@ 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 dsco; + -- Debug routine to dump SCO table. This is a raw format dump showing + -- exactly what the tables contain. + 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; diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 6597f26..d7667b8 100644 --- a/gcc/ada/put_scos.adb +++ b/gcc/ada/put_scos.adb @@ -29,7 +29,7 @@ procedure Put_SCOs is begin -- 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 SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U); @@ -50,16 +50,23 @@ begin -- Loop through SCO entries for this unit - Start := SCO_Table.First; - Stop := SCO_Table.Last; + Start := SUT.From; + Stop := SUT.To; loop - declare + 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; + procedure Output_Range (T : SCO_Table_Entry); -- 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 Write_Info_Nat (Nat (T.From.Line)); Write_Info_Char (':'); @@ -70,6 +77,8 @@ begin 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); @@ -80,7 +89,7 @@ begin when 'S' | 'T' => Write_Info_Char (' '); - Output_Range; + Output_Range (T); -- Decision @@ -107,7 +116,7 @@ begin else Write_Info_Char (T.C2); - Output_Range; + Output_Range (T); end if; exit when T.Last; @@ -120,19 +129,10 @@ begin end case; Write_Info_Terminate; - end; + end Output_SCO_Line; - 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; diff --git a/gcc/ada/put_scos.ads b/gcc/ada/put_scos.ads index a2ea41e..d8d7720 100644 --- a/gcc/ada/put_scos.ads +++ b/gcc/ada/put_scos.ads @@ -31,7 +31,10 @@ with Types; use Types; 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 <>; -- Outputs one character diff --git a/gcc/ada/scos.adb b/gcc/ada/scos.adb index e5dfcd2..c559e6f 100644 --- a/gcc/ada/scos.adb +++ b/gcc/ada/scos.adb @@ -25,9 +25,13 @@ package body SCOs is + ------------- + -- Add_SCO -- + ------------- + procedure Add_SCO - (From : Source_Location := No_Location; - To : Source_Location := No_Location; + (From : Source_Location := No_Source_Location; + To : Source_Location := No_Source_Location; C1 : Character := ' '; C2 : Character := ' '; Last : Boolean := False) @@ -36,4 +40,18 @@ package body SCOs is SCO_Table.Append ((From, To, C1, C2, Last)); 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; diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 0e64162..b1d99e1 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -210,7 +210,7 @@ package SCOs is Col : Column_Number; 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 From : Source_Location; @@ -282,9 +282,8 @@ package SCOs is -- 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 - -- unused, it is for convenience in calling the sort routine. The Info - -- field is an identifier supplied when an entry is built (e.g. in the - -- compiler this is the Unit_Number_Type value. + -- unused, it is for convenience in calling the sort routine. Thus the + -- real lower bound for active entries is 1. type SCO_Unit_Index is new Int; -- Used to index values in this table. Values start at 1 and are assigned @@ -307,7 +306,7 @@ package SCOs is package SCO_Unit_Table is new GNAT.Table ( Table_Component_Type => SCO_Unit_Table_Entry, Table_Index_Type => SCO_Unit_Index, - Table_Low_Bound => 0, + Table_Low_Bound => 0, -- see note above on sorting Table_Initial => 20, Table_Increment => 200); @@ -315,9 +314,12 @@ package SCOs is -- Subprograms -- ----------------- + procedure Initialize; + -- Reset tables for a new compilation + procedure Add_SCO - (From : Source_Location := No_Location; - To : Source_Location := No_Location; + (From : Source_Location := No_Source_Location; + To : Source_Location := No_Source_Location; C1 : Character := ' '; C2 : Character := ' '; Last : Boolean := False); diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index a60b83e..ffda3ab 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -954,7 +954,7 @@ __gnat_get_task_options (void) /* Force VX_FP_TASK because it is almost always required */ options |= VX_FP_TASK; -#if defined (_SPE_) +#if defined (__SPE__) options |= VX_SPE_TASK; #endif diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 68851c3..5e168d2 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -66,6 +66,7 @@ gcc -c ^ GNAT COMPILE -gnateG ^ /GENERATE_PROCESSED_SOURCE -gnatem ^ /MAPPING_FILE -gnatep ^ /DATA_PREPROCESSING +-gnateS ^ /SCO_OUTPUT -gnatE ^ /CHECKS=ELABORATION -gnatf ^ /REPORT_ERRORS=FULL -gnatF ^ /UPPERCASE_EXTERNALS diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 3e91774..aac1c78 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -2183,6 +2183,16 @@ package VMS_Data is -- -- 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=*" & "-I*"; -- /SEARCH=(directory[,...]) @@ -3474,6 +3484,7 @@ package VMS_Data is S_GCC_Repinfo 'Access, S_GCC_RepinfX 'Access, S_GCC_RTS 'Access, + S_GCC_SCO 'Access, S_GCC_Search 'Access, S_GCC_Style 'Access, S_GCC_StyleX 'Access, -- cgit v1.1