par_sco.adb: Add SCO generation for task types and single task declarations.
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:
parent
8ed7930e45
commit
7130729aa0
@ -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>
|
||||
|
@ -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: */
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 := ' ';
|
||||
|
||||
|
@ -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).
|
||||
|
@ -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_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 --
|
||||
|
Loading…
x
Reference in New Issue
Block a user