OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

par_sco.adb: Add SCO generation for task types and single task declarations.

Browse Source 
2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb: Add SCO generation for task types and single
	task declarations.

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* fe.h, gnat1drv.adb: Revert previous change.

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* get_scos.adb: When adding an instance table entry for a
	non-nested instantiation, make sure the Enclosing_Instance is
	correctly set to 0.

From-SVN: r194793
This commit is contained in:
Thomas Quinot 2013-01-02 10:45:00 +00:00 committed by Arnaud Charlet
parent 8ed7930e45
commit 7130729aa0
8 changed files with 78 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2013-01-02 Thomas Quinot <quinot@adacore.com>
* par_sco.adb: Add SCO generation for task types and single
task declarations.
* get_scos.adb: When adding an instance table entry for a
non-nested instantiation, make sure the Enclosing_Instance is
correctly set to 0.
2013-01-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Analyze_Attribute): Skip the special _Parent
@ -12,8 +20,6 @@
* switch-c.adb, fe.h, back_end.adb: Enable generation of instantiation
information in debug info unconditionally when using -fdump-scos,
instead of relying on a separate command line switch -fdebug-instances.
* gcc-interface/gigi.h, gcc-interface/misc.c
(set_flag_debug_instances): New subprogram.
* gcc-interface/Make-lang.in: Update dependencies.
2013-01-02 Ed Schonberg <schonberg@adacore.com>

2
gcc/ada/fe.h
View File

@ -182,6 +182,7 @@ extern Boolean In_Same_Source_Unit (Node_Id, Node_Id);
#define Exception_Extra_Info opt__exception_extra_info
#define Exception_Locations_Suppressed opt__exception_locations_suppressed
#define Exception_Mechanism opt__exception_mechanism
#define Generate_SCO_Instance_Table opt__generate_sco_instance_table
#define Global_Discard_Names opt__global_discard_names
typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type;
@ -190,6 +191,7 @@ extern Boolean Back_Annotate_Rep_Info;
extern Boolean Exception_Extra_Info;
extern Boolean Exception_Locations_Suppressed;
extern Exception_Mechanism_Type Exception_Mechanism;
extern Boolean Generate_SCO_Instance_Table;
extern Boolean Global_Discard_Names;
/* restrict: */

2
gcc/ada/gcc-interface/gigi.h
View File

@ -255,8 +255,6 @@ extern void gigi (Node_Id gnat_root, int max_gnat_node,
Entity_Id standard_exception_type,
Int gigi_operating_mode);
extern void set_flag_debug_instances (int);
#ifdef __cplusplus
}
#endif

17
gcc/ada/gcc-interface/misc.c
View File

@ -809,23 +809,6 @@ gnat_eh_personality (void)
return gnat_eh_personality_decl;
}
/* Set flag_debug_instances. */
void
set_flag_debug_instances (int val ATTRIBUTE_UNUSED)
{
#if 0
/* Temporary compatibility shim???
This should be enabled when back-end support for instance info in
DWARF is merged at the FSF. */
flag_debug_instances = val;
#else
/* Until then, forcibly turn off SCO instance table generation. */
extern Boolean opt__generate_sco_instance_table;
opt__generate_sco_instance_table = False;
#endif
}
/* Initialize language-specific bits of tree_contains_struct. */
static void

10
gcc/ada/gcc-interface/trans.c
View File

@ -302,6 +302,16 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
type_annotate_only = (gigi_operating_mode == 1);
#if 0
if (Generate_SCO_Instance_Table)
flag_debug_instances = 1;
#else
/* Temporary compatibility shim: FSF head back-end does not support instance
based debug info discriminators, so disable the generation of the SCO
instance table. ??? */
Generate_SCO_Instance_Table = False;
#endif
for (i = 0; i < number_file; i++)
{
/* Use the identifier table to make a permanent copy of the filename as

10
gcc/ada/get_scos.adb
View File

@ -205,7 +205,7 @@ procedure Get_SCOs is
Nam : Name_Id;
-- Start of processing for Get_Scos
-- Start of processing for Get_SCOs
begin
SCOs.Initialize;
@ -265,7 +265,9 @@ begin
pragma Assert (C = '|');
Get_Source_Location (SIE.Inst_Loc);
if not At_EOL then
if At_EOL then
SIE.Enclosing_Instance := 0;
else
Skip_Spaces;
SIE.Enclosing_Instance :=
SCO_Instance_Index (Get_Int);
@ -342,6 +344,10 @@ begin
Key := '>';
Typ := Getc;
-- Sanity check on dominance marker type indication
pragma Assert (Typ in 'A' .. 'Z');
when '1' .. '9' =>
Typ := ' ';

7
gcc/ada/gnat1drv.adb
View File

@ -109,9 +109,6 @@ procedure Gnat1drv is
----------------------------
procedure Adjust_Global_Switches is
procedure set_flag_debug_instances (Val : Int);
pragma Import (C, set_flag_debug_instances);
begin
-- Debug flag -gnatd.I is a synonym for Generate_SCIL and requires code
-- generation.
@ -576,10 +573,6 @@ procedure Gnat1drv is
end if;
end if;
-- Set back-end flag_debug_instances from corresponding front-end flag
set_flag_debug_instances (Boolean'Pos (Generate_SCO_Instance_Table));
-- Finally capture adjusted value of Suppress_Options as the initial
-- value for Scope_Suppress, which will be modified as we move from
-- scope to scope (by Suppress/Unsuppress/Overflow_Checks pragmas).

80
gcc/ada/par_sco.adb
View File

@ -154,18 +154,21 @@ package body Par_SCO is
-- Process L, a list of statements or declarations dominated by D.
-- If P is present, it is processed as though it had been prepended to L.
-- The following Traverse_* routines perform appropriate calls to
-- Traverse_Declarations_Or_Statements to traverse specific node kinds
procedure Traverse_Generic_Package_Declaration (N : Node_Id);
procedure Traverse_Handled_Statement_Sequence
(N : Node_Id;
D : Dominant_Info := No_Dominant);
procedure Traverse_Package_Body (N : Node_Id);
procedure Traverse_Package_Declaration (N : Node_Id);
procedure Traverse_Protected_Body (N : Node_Id);
procedure Traverse_Protected_Definition (N : Node_Id);
procedure Traverse_Package_Body (N : Node_Id);
procedure Traverse_Package_Declaration (N : Node_Id);
procedure Traverse_Subprogram_Or_Task_Body
(N : Node_Id;
D : Dominant_Info := No_Dominant);
-- Traverse the corresponding construct, generating SCO table entries
procedure Traverse_Sync_Definition (N : Node_Id);
-- Traverse a protected definition or task definition
procedure Write_SCOs_To_ALI_File is new Put_SCOs;
-- Write SCO information to the ALI file using routines in Lib.Util
@ -958,9 +961,7 @@ package body Par_SCO is
N_Task_Body |
N_Generic_Instantiation =>
Traverse_Declarations_Or_Statements
(L => No_List,
P => Lu);
Traverse_Declarations_Or_Statements (L => No_List, P => Lu);
when others =>
@ -1356,14 +1357,17 @@ package body Par_SCO is
N_Timed_Entry_Call |
N_Conditional_Entry_Call |
N_Asynchronous_Select |
N_Single_Protected_Declaration =>
N_Single_Protected_Declaration |
N_Single_Task_Declaration =>
T := F;
when N_Protected_Type_Declaration =>
when N_Protected_Type_Declaration | N_Task_Type_Declaration =>
if Has_Aspects (N) then
To_Node := Last (Aspect_Specifications (N));
elsif Present (Discriminant_Specifications (N)) then
To_Node := Last (Discriminant_Specifications (N));
else
To_Node := Defining_Identifier (N);
end if;
@ -1550,7 +1554,7 @@ package body Par_SCO is
when N_Protected_Body =>
Set_Statement_Entry;
Traverse_Protected_Body (N);
Traverse_Declarations_Or_Statements (Declarations (N));
-- Exit statement, which is an exit statement in the SCO sense,
-- so it is included in the current statement sequence, but
@ -1960,18 +1964,18 @@ package body Par_SCO is
-- All other cases, which extend the current statement sequence
-- but do not terminate it, even if they have nested decisions.
when N_Protected_Type_Declaration =>
when N_Protected_Type_Declaration | N_Task_Type_Declaration =>
Extend_Statement_Sequence (N, 't');
Process_Decisions_Defer (Discriminant_Specifications (N), 'X');
Set_Statement_Entry;
Traverse_Protected_Definition (Protected_Definition (N));
Traverse_Sync_Definition (N);
when N_Single_Protected_Declaration =>
when N_Single_Protected_Declaration | N_Single_Task_Declaration =>
Extend_Statement_Sequence (N, 'o');
Set_Statement_Entry;
Traverse_Protected_Definition (Protected_Definition (N));
Traverse_Sync_Definition (N);
when others =>
@ -2112,36 +2116,52 @@ package body Par_SCO is
Traverse_Declarations_Or_Statements (Private_Declarations (Spec));
end Traverse_Package_Declaration;
-----------------------------
-- Traverse_Protected_Body --
-----------------------------
------------------------------
-- Traverse_Sync_Definition --
------------------------------
procedure Traverse_Protected_Body (N : Node_Id) is
begin
Traverse_Declarations_Or_Statements (Declarations (N));
end Traverse_Protected_Body;
procedure Traverse_Sync_Definition (N : Node_Id) is
Dom_Info : Dominant_Info := ('S', N);
-- The first declaration is dominated by the protected or task [type]
-- declaration.
-----------------------------------
-- Traverse_Protected_Definition --
-----------------------------------
Sync_Def : Node_Id;
-- N's protected or task definition
procedure Traverse_Protected_Definition (N : Node_Id) is
Dom_Info : Dominant_Info := ('S', Parent (N));
Vis_Decl : constant List_Id := Visible_Declarations (N);
Vis_Decl : List_Id;
-- Sync_Def's Visible_Declarations
begin
case Nkind (N) is
when N_Single_Protected_Declaration | N_Protected_Type_Declaration =>
Sync_Def := Protected_Definition (N);
when N_Single_Task_Declaration | N_Task_Type_Declaration =>
Sync_Def := Task_Definition (N);
when others =>
raise Program_Error;
end case;
Vis_Decl := Visible_Declarations (Sync_Def);
Traverse_Declarations_Or_Statements
(L => Vis_Decl,
D => Dom_Info);
-- If visible declarations are present, the first private declaration
-- is dominated by the last visible declaration.
-- This is incorrect if Last (Vis_Decl) does not generate a SCO???
if not Is_Empty_List (Vis_Decl) then
Dom_Info.N := Last (Vis_Decl);
end if;
Traverse_Declarations_Or_Statements
(L => Private_Declarations (N),
(L => Private_Declarations (Sync_Def),
D => Dom_Info);
end Traverse_Protected_Definition;
end Traverse_Sync_Definition;
--------------------------------------
-- Traverse_Subprogram_Or_Task_Body --