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

gcc/ada/ChangeLog

+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>

gcc/ada/fe.h

@@ -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: */

gcc/ada/gcc-interface/gigi.h

@@ -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

gcc/ada/gcc-interface/misc.c

@@ -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

gcc/ada/gcc-interface/trans.c

@@ -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

gcc/ada/get_scos.adb

@@ -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 := ' ';
 

gcc/ada/gnat1drv.adb

@@ -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).

gcc/ada/par_sco.adb

@@ -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 --